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Summary 


The  objective  of  the  effort  covered  by  this  report  was  to  provide 
a  set  of  software  tools  which  can  be  used  for  data  collection  and 
presentation.  Data  collection  was  implemented  using  a  network 
analyzer  and  a  water  loaded  microwave  scanner.  Transmission  and 
reflection  data  was  acquired  with  this  system  and  representative 
data  is  presented  in  this  report.  The  data  acquisition  speed  of 
the  network  analyzer  was  improved  by  a  factor  of  two  by  rewriting 
the  measurement  software. 
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SECTION  I 


Introduction 


The  developments  described  in  this  Annual  Report  cover 
software  programs  and  system  modifications  which  were  developed 
to  provide  various  options  for  scanning  an  object  with  the  water 
loaded  microwave  scanner.  All  the  programs  were  designed  to  be 
used  in  an  interactive  mode.  The  user  is  presented  with  a  menu 
or  quired  for  the  parameters  necessary  to  make  the  desired 
measurements.  This  report  presents  a  brief  overview  of  the 
system  capabilities  and  provides  samples  of  the  results  obtained 
with  the  system.  Complete  operational  procedures  along  with  a 
detailed  description  of  the  various  programs  can  be  found  in  the 
System  Users  Manual.  As  can  be  seen  from  the  presented  data,  the 
microwave  scanner  system  is  operational  at  the  present  time. 
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SECTION  II 


DATA  COLLECTION  CAPABILITIES 


A.  LINE  SCANS 


The  basic  capability  needed  to  obtain  a  picture  of  a  sample 
is  to  be  able  to  scan  along  the  sample  in  a  straight  line.  The 
system  provides  this  capability  by  having  the  sample  remain  fixed 
while  the  two  antennae  (transmitting  on  one  side  of  the  sample 
and  receiving  on  the  other  side)  are  moved  together  along  a 
straight  line.  Figure  1  shows  a  plot  of  a  simple  line  scan  taken 
of  a  hollow  epoxy-nylon  tube  of  8  mm  outside  diameter  and  6  mm 
inside  diameter.  The  antennae  were  about  2  mm  to  either  side  of 
the  tube. 


The  frequency  was  2.6  Giga-hertz.  The  frequency  of  a  scan 
can  be  set  anywhere  from  2.5  Giga-hertz  to  3.5  Giga-hertz.  The 
electronics  can  actually  range  from  100  Mega-hertz  to  12.4 
Giga-hertz  but  the  antennae  are  very  inefficient  beyond  the  range 
of  2.5  to  3.5  Giga-hertz. 


The  user  has  the  capability  of  scanning  over  many 
frequencies  during  a  line  scan.  Figure  2  shows  the  same  sample 
as  figure  1  with  the  frequency  varying  from  2.5  Giga-hertz  to  3.5 
Giga-hertz  in  steps  of  .1  Giga-hertz.  Each  line  has  its  own 
marker  with  the  first  1  to  9  frequencies  marked  with  ”1”  to  ”9'* 
respectively.  The  tenth  frequency  is  marked  with  and  the 
eleventh  with  Both  figure  1  and  figure  2  are  copies  of  what 
appears  on  the  CRT  during  a  scan  and  are  provided  to  give  the 
user  a  compact  representation  of  the  data.  From  figure  2  one  can 
see  that  each  of  the  frequencies  gives  approximately  the  same 
shape  of  line  scan  but  the  overall  attenuation  varies  greatly 
with  2.5  Giga-hertz  having  the  most  and  2.9  Giga-hertz  having  the 
least  attenuation.  If  the  user  later  decides  he  wants  to  look 
more  closely  at  a  graph  of  one  frequency^  he  can  go  back  to  the 
data  and  have  a  single  frequency  plotted.  Figures  3  to  13  show  a 
scan  similar  to  that  shown  in  figure  2,  but  each  frequency  is 
plotted  separately. 


One  usually  takes  transmission  data  to  get  a  representation 
of  the  inside  of  a  sample  as  was  done  to  make  figures  1  to  13. 
Howeverr  one  can  obtain  other  useful  information  by  measuring  the 
attenuation  of  the  reflected  wave.  The  user  has  the  capability 
of  taking  reflection  scans  in  the  same  manner  as  transmission 
scans  are  taken.  The  graphs  are  similar  to  the  transmission 
graphs  except  that  the  attenuation  is  much  greater. 
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The  user  also  has  the  capability  of  repeating  the  neasureinent 
several  tines  at  each  data  point  for  statistical  averaging.  If  a 
frequency  scan  is  done*  the  frequency  is  scanned  before  any 
measurements  are  repeated  instead  of  repeating  the  measurements 
at  each  frequency  of  a  frequency  scan.  It  is  done  this  way  to 
have  the  greatest  time  between  different  measurements  of  the  same 
frequency. 

The  position  accuracy  of  a  linear  scan  was  measured  by 
measuring  the  difference  between  the  desired  position  and  the 
achieved  position.  Ten  measurements  were  taken  for  each  of  three 
days.  The  root  mean  square  difference  between  the  desired  and 
achieved  position  is  .002  mm.  The  time  required  to  run  a  scan 
can  be  quite  long  since  a  typical  scan  usually  has  several 
thousand  data  points.  If  we  take  a  linear  scan  with  only  one 
attenuation  measurement  per  position,  the  time  for  each  position 
was  found  to  be  2.3  seconds.  This  time  was  measured  with  a  stop 
watch  by  measuring  the  time  it  takes  to  run  a  scan  over  32 
positions  at  one  frequency  and  with  no  statistical  averaging. 
From  previous  measurements,  the  time  to  move  the  position  1  mm 
was  found  to  be  1.3  seconds.  Therefore  the  other  second  can  be 
assumed  to  be  used  to  take  the  attenuation  measurement.  Thus  the 
time  per  scan  can  be  given  by  the  formula: 

for  step  sizes  up  to  2.9  mm 
T  *  Nptl.3*sgrt (d) 1  +  Na 

for  1  nun  step  size,  this  reduces  to 
T  «  1.3  Np  +  Na 

for  step  sizes  greater  than  2.9  mm 
T  »  Np[2.2  +  0.06(d-29)J  +  Na 

Where 

T  «  time  in  seconds  for  the  scan 
Na  -  number  of  measurements 
Np  >  number  of  positions 

d.  «  distence  between  measurement  points  in  millimeters 
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B.  RASTER  SCAN 


The  use.  has  the  capability  of  making  a  two  dimensional 
(raster)  scan.  This  is  done  as  a  series  of  line  scansr  with  each 
one  incremented  in  elevation.  The  equipment  is  capable  of  a 
range  of  elevation  of  about  195  mm  and  a  range  of  azimuth  of 
about  155  mm. 


The  user  is  also  capable  of  scanning  over  many  frequencies 
during  a  raster  scan.  This  is  done  by  scanning  over  the 
frequencies  at  avery  position  of  the  raster  scan.  The  possible 
range  of  frequencies  is  2.5  to  3.5  Giga-hertz,  with  the  limiting 
factor  being  the  efficiency  range  of  the  antennae. 


The  user  has  the  capability  of  measuring  the  attenuation  of 
either  the  transmitted  or  the  reflected  wave  in  a  raster  scan. 
The  main  difference  between  the  two  is  that  the  reflected  wave 
has  much  more  attenuation. 


The  position,  attenuation,  and  phase  are  stored  in  a  disc 
file  at  every  position.  At  the  end  of  every  line  scan,  the 
elevation  and  frequency  are  recorded.  If  a  frequency  scan  is 
taken,  each  line  scan  is  recorded  separately  for  each  frequency. 
Thus  each  record  on  disc  consists  of  a  line  scan.  For  any  type 
of  scan  the  record  format  on  disc  is  the  same. 


The  user  has  the  capability  of  displaying  the  data  in 
various  ways  during  a  raster  scan.  He  can  have  the  frequency, 
azimuth,  attenuation,  and  phase  listed  on  a  printer.  Re  can  have 
graphs  of  the  attenuation  plotted  on  the  CRT  or  on  a  hard  copy 
plotter.  A  graph  plotted  on  the  CRT  can  be  copied  onto  a 
different  hard  copy  plotter.  One  line  scan  is  plotted  per 
graph.  Thus,  if  a  frequency  scan  is  done,  a  graph  will  contain 
plots  of  all  the  frequencies  scanned.  Figure  14  shows  such  a 
graph  of  a  line  scan  with  11  frequencies  plotted.  Each  line  has 
its  own  marker  with  the  first  1  to  9  frequencies  marked  with  a 
■1"  to  ■9"  respectively.  The  tenth  line  is  marked  with  a  and 
the  eleventh  with  If  the  user  later  decides  he  wants  to  look 
more  closely  at  a  graph  of  one  frequency,  he  can  retrieve  the 
data  from  the  disc  file  and  have  a  single  frequency  plotted. 
Figures  15  to  25  show  the  output  of  the  raster  scan  program  for 
one  line.  Since  the  object  being  scanned  is  a  uniform  tube,  the 
other  63  line  scans  are  similar  to  these  graphs. 
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The  user  also  has  the  capability  of  taking  reflection  scans  in 
the  same  manner  as  transmission  scans  are  taken.  The  data  is 
similar  to  the  transmission  data  except  that  the  reflection 
attenuation  is  much  greater. 

The  user  also  has  the  capability  of  repeating  each 
measurement  several  times  for  statistical  averaging.  If  a 
frequency  scan  is  done,  a  frequency  scan  is  completed  and  then 
repeated  for  the  statistical  number  of  times  and  then  the 
antennae  are  moved  on  to  the  next  position.  This  method  provides 
the  greatest  time  between  measurements  of  the  same  frequency 
while  keeping  the  time  per  scan  to  a  minimum. 

Since  a  raster  scan  consists  of  many  line  scans,  the 
beginning  position  is  not  reset  for  each  line  scan.  Instead, 
every  other  line  scan  moves  in  the  opposite  direction. 


I 


i 


HttvmMtlan  (M)  att*Mi«tl*n  (4b) 


Figure  15 
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2.  6  Giga-  hertz 


8mm  O.  D.  tube 
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Figure  17 
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2.8  Giga-hertz  8mm  O.  D.  tube 
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3.3  Giga- hertz 


8  mm  O.  D.  tube 


Figure  24 
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3.  4  Giga-  hertz 


8mm  O.  D.  tube 
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Figure  25 


C.  ROTATION  AND  TRANSLATION 


The  user  has  the  capability  of  making  a  linear  scan  coupled 
with  a  rotational  scan.  These  are  done  as  a  series  of  line 
scans,  each  one  at  a  slightly  different  angle.  The  equipment  is 
capable  of  a  maximum  rotation  of  190  degrees.  If  the  user  starts 
the  scan  at  the  endpoint  of  this  range,  he  can  scan  over  the  full 
range  of  190  degrees. 


The  transmission  attenuation  is  measured  and  stored  in  a 
disc  file  along  with  the  position  and  phase  at  every  data  point. 
At  the  end  of  every  line  scan  the  angle  and  frequency  are 
recorded  before  changing  the  angle. 


The  user  has  the  capability  of  displaying  the  data  in 
various  ways  during  the  scan.  He  can  have  the  position, 
attenuation  and  phase  recorded  on  a  printer.  He  can  have  graphs 
of  the  attenuation  plotted  on  the  CRT  or  on  a  hard  copy  plotter. 
A  graph  plotted  on  the  CRT  can  be  copied  onto  a  different  hard 
copy  plotter.  The  user  has  the  capability  of  plotting  only  every 
nth  line  scan,  where  n  can  be  any  integer  from  1  up  to  the  number 
of  scans.  Before  any  graphs  are  plotted  on  the  CRT,  the 
position,  attenuation,  and  phase  are  listed  on  the  CRT.  Thus  the 
user  has  the  capability  of  checking  the  data  as  soon  as  it  is 
taken. 


The  user  has  the  capability  of  repeating  the  measurement  any 
number  of  times  at  each  data  point  for  the  purpose  of  statistical 
averaging.  When  more  than  one  measurement  is  taken  per  data 
point,  the  averaging  is  done  before  any  data  is  recorded  in  the 
disc  file  or  on  the  printer  or  plotted  so  that  there  is  only  one 
value  of  attenuation  and  phase  recorded  at  each  position.  The 
fact  that  many  measurements  were  averaged  to  arrive  at  each 
recorded  value  is  recorded  at  the  beginning  of  the  file. 


Since  many  line  scans  can  be  done  at  many  angles,  the  time 
involved  can  be  quite  long.  Therefore  after  a  line  scan  is 
finished  and  the  angle  is  incremented,  the  azimuth  position  is 
not  reset  to  the  same  position  where  the  last  line  scan  started. 
Instead,  every  other  line  scan  moves  in  the  opposite  direction  so 
that  no  resetting  is  necessary. 


D.  Antenna  Subarrav  Verification 


A  seven  element  subarray  of  the  much  larger  array  was 
fabricated  and  tested  for  the  purpose  of  verifying  the  antenna 
design.  Two  programs  were  written  to  make  the  required 
measurements.  The  first  program  measured  the  VSWR  of  each 
element  when  driven  from  a  50  Ohm  source.  The  second  program 
measured  the  coupling  between  various  elements  in  the  subarray. 


The  data  presented  on  the  following  pages  was  collected  with 
the  subarray  mounted  on  the  water  loaded  scanner.  The  subarray 
was  positioned  approximately  twelve  inches  below  the  surface  of 
the  water.  The  numbering  for  the  elements  of  the  subarray  and 
their  relative  position  is  shown  in  figure  6. 
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Figure  6 
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SUBARRAY  VERIFICATION 
ELEMENT  *  1 


Measur enen  t 

Date:  12:50 

FM  FRI., 

5 

OCT.,  1984 

Colibration 

Date:  11:34 

AH  FRI., 

5 

OCT.,  1984 

Frequency 

Sll 

VSWR 

Return 

1 

Magnitude 

Phase 

2000.000 

.5946 

118.7 

3.933 

-  ^,516 

2050.000 

.5684 

-90.2 

3.634 

4.907 

2100.000 

.5683 

58.9 

3.632 

4.909 

2150 . 000 

—,5124 

-151.0 

3.102 

—5.808 

2200.000 

.5215 

-.8 

3.180 

5.654 

2250 .000 

.4594 

150.1 

2.700 

6.755 

2300.000 

,4390 

-52.4 

2.565  - 

--  7.151 

2350.000 

.4149 

84.6 

2,418 

7.641 

2400.000 

.3665 

-102.1 

2.157 

8.718 

. .  .9A^(i  .  AAA 

.3738 

35  I  3 

5. 194 

S .  548 

2500.000 

.3190 

-ibS,7 

1^937 

9.9ZA 

2550.000 

.3213 

-15.5 

1.947 

9.862 

2600.000 

,5687 

430.7 

1.735  -- 

-11.415  - 

2650.000 

.2479 

-63.8 

1.659 

12.116 

2700.000 

.2149 

85.2 

1.547 

13.357 

2750.000 

- .1816 

- -114,1 

— 

- 1.444  - 

— 14.816  - 

2800.000 

.1842 

44.0 

1.452 

14.693 

2850 . 000 

.1419 

-150.1 

1.331 

16.960 

9Qnn .non 

1 1646 

- .  9 

1 . 394 

4C  A.*7T 

2950.000 

!i273 

174.6 

1.292 

17.905 

3000.000 

.1690 

-29.2 

1.407 

15.443 

- ^050.000 

1493 

- 132.5 

_ 

- 1.351  - 

- 16.519  - 

3100.000 

.1970 

-65.5 

1.491 

14.112 

3150.000 

.2018 

80.8 

1.506 

13.901 

-  -3200.000 

,5218 

- 106.6 

— 

1.570  -- 

— 13.079  — 

3250.000 

.2435 

35.3 

1.644 

12.272 

3300,000 

.2516 

-162.5 

1.673 

11.984 

'T^^A  .000 

_ .2988 

-  -j-l  1 . 3 

_ -i,as2 

_ iQ , 494 

3400.000 

.2865 

140.4 

1.803 

10^859 

3450 . 000 

.3425 

-67.9 

2.042 

9.308 

3500.000 

.3308 

77.4 

1.989 

9.609 

3550.000 

.3680 

-127.4 

2.165 

8.682 

3600.000 

.3750 

28.5 

2.200 

8.518 

—  ]  - 


3650 . 000 

,3724 

177.6 

2.187 

8.SQ0 

3700.000 

.4281 

-27.3 

2.497 

7.368 

3750 . 000 

.4021 

124.7 

2,345 

7.912 

3800.000 

.4450 

-83.2 

2.604 

7.033 

3850 . 000 

.4453 

60.8 

2.605 

7.027 

3900.000 

.4306 

-141.6 

2.513 

7.318 

3950 . 000 

.4664 

4.7 

2.748 

6.624 

3999,999 

.4445 

166.7 

2.600 

7 . 043 

-24- 


****************************************************** 

Ualttr  R««d  Arny  In«titwtc  cf  Rcstarch  * 

O«portn€nt  of  Hicrowavo  Rtscorch  * 

Walttr- Raod  ArMy-H«dieol  C€iif«r-  —  * 

Washington,  DC  2ttl2  * 

i««»*««««C««««*««*««««R«M«*«»««*«**««R«*«*«**«******** 


SUBARRAY  vaXFZCATlQN 
ELEMENT  •  2 


N«asurtn«nt  Oatdi  12tS2  FN  FRX.,  S  OCT.,  19B4 


Calibration  Ootnt  ii:34  AH  FRX.,  S  OCT.,  19B4 


Froqutncy 
-  -<HHa) - 


200R.00R— 

aoso.oot 
2100.001 
aiso.oot— 
2200.000 
2250,000 
2300.000- 
2350.000 
2400.000 
2450.000— 
2500.000 
2550.000 
2600.000— 
2650.000 
2700.000 
2750.000— 
2800.000 
2850.000 
2900.000- 
2950.000 
3000.000 
3050.000- 
3100.000 
3150,000 
3200.000 — 
3250.000 
3300.000 
3350.000-  - 
3400.000 
3450.000 
3500.000 
3550.000 
3600.000 


Moqnltuda  Pha«« 


3650.000 

3700.000 

3750.000 

3800-.000— 

3850.000 

3900.000 

3956.000- 

3999,999 


.3957 - 

.3645 

.4054 

.3813 - 

.4345 

.4084 

.4143 - 

.4199 
.3725 
.  4013" 
.3460 
.3736 

.3216 - 

.3166 

.2936 

.2575 - 

.2729 

.2133 

.2471 - 

.2010 

.2293 

.2033 - 

.2087 

.2254 

.2030 - 

.2563 
.2035 
.  2722- — 
.2361 
.2828 
.2984 
.2820 
.3435 

.2987 

.3669 

.3367 

.  3785 - 

.3932 

.3752 

.4318 - 

.3995 


-  81.7— 
-117.5 

35.4 

- 17t.8— 

-19.7 

128.8 

-  -72t5— 

61.8 

-126.7 

-  10.5— 
169.2 
-42.0 
101.7— 
-93.7 

50.5 
-150.4 — 

4.7 

161.8 
-52.2 — 

109.7 
-89.2 

52.1 — 
-131.7 

4.7 

-174.4 — 
-32.6 

125.8 
-74.4 — 

66.5 
-123.6 

11.9 

175.8 
-31.8 

115.5 
-85.3 

63.1 

-130. 3 — 

1.5 

157.5 

-  -53^2 - 

105.1 

-25- 


2.310 - 

2.147 

2.363 

-2.233 - 

2.537 

2.381 

2.414 - 

2.447 

2.187 

2.340 - 

2.058 

2.193 

1.948 - 

1.927 

1.831 

I . 694 - 

1.751 

1.542 

1 . 656 - 

1.503 

1.595 

1.510 - 

1.528 

1.582 

1.510  - 

1.689 

1.511 

1.748 - 

1.618 

1.789 

1.850 

1,786 

2.046 

1.852 

2.159 

2.015 

-7.218 - 

2.296 

2.201 

-7.520 - 

2.331 


Return 
-Lusn- (48 


-  8.052 — 
8.766 
7.843 

-  8.374 — 
7.240 
7.778 
7.655 — 
7.538 
8.577 
7.931 — 
9.218 
8.552 

9 . 853 — 
9.990 
10.644 
11.785 — 
11.281 
13.420 
12.143- 
13.935 
12.793 
13.838- 
13.609 
12.942 
13.845- 
11.826 
13.830 
11.306  - 
12.539 

10.969 
10.505 
10.995 

9.282 

10.496 

8.708 

9.454 

8.440 - 

8.108 
8.514 
-7.294 - 

7.969 


«««««««»«««««»««*««««««««««**«««*««*«*»«»««««*«#*«**« 

Walter  Read  Arny  Znetitvte  •f  Reeearch 
Departnent  of  Hicrowave  Reeearch 
Walter  Reed  Arnp  Hedlcal  Center 
Woshington,  DC  20112 


8UBARRAY  VERIFICATION 
ELEMENT  •  3 


Meaeurenent  Datei  12:53  PH  FRI., 


5  OCT.,  1984 


Calibration  Date:  11:34  AH  FRI.,  5  OCT.,  1984 


Frequencf 
(MHi) - 


811 


Magnitude  Phase 


VSWR 


Return 
Lose- (d8 


2000.000— 
2050.000 
2100.000 
2150.000— 
2200.000 
2250.000 
2300.000-  - 
2350.000 
2400.000 
2450.000- 
2500.000 
2550.000 
2600.000- 
2650.000 
2700.000 
2750.000 — 
2800.000 
2850.000 
2900.000 
2950.000 
3000.000 


.6463- 

.3384 

.6106 

.5668- 


.5684 
.5335 
.4879 — 
.4782 
.4006 
.  4075-  - 
.3401 
.3457 
.2870-  - 
.2596 
.2390 
.1758 — 
.1929 
.1196 
.1458 — 
.0990 
.1280 


8S,7- 

180.0 

27.0 

173.0- 

-35.1 

111.3 

-92.8- 

44.8 

-150.2 

-9.1- 

146.8 
-61.6 

80.1 

-114.9 

29.5 

-170.4- 

-15.3 

141.1 

-61.9- 

100.9 
-85.7 


4.655-  - 

2.023 

4.136 

3.616 - 

3.634 

3.288 

2.905 - 

2.833 

2.336 

2.376 - 

2.031 
2.057 
1.805- 
1.701 
1.628 
1 . 427— 
1.478 
1.272 

1.341 - 

1.220 

1.294 


9.369 
9.225 
10.844- 
11  712 
12.430 
15.099- 


14.295 
18.443 
16. 724-- 
20.090 
17.853 


3050.004  - 

.1043 - 

-  63.7 - 

1 . 233— 

-  19.637- 

3100.000 

.1311 

-111.0 

1.302 

17 . 646 

3150.000 

.1425 

25.3 

1.332 

16.921 

3200.000 

.1514 - 

-  -149.3  -  - 

1.356- 

-  16.420 - 

3250.000 

.1936 

-11.9 

1.480 

14.260 

3300.000 

3350.000 

.  1733 

944  9 

152.5 

-ee  B _ 

1.419 

1.636- 

15.222 

_ . 352  _ 

•  - 

3400.000 

.2132 

91.1 

1.542 

13.425 

3450.000 

.2739 

-107.8 

1.754 

11.249 

3500.000 

.2814 

30.8 

1.784 

11 . 008 

3550.000 

.2937 

-170.9 

1.832 

10.641 

3600.000 

.3431 

-18.1 

2.045 

9.291 

3650.000 

.3155 

129.4 

1.922 

10.019 

3700.000 

.3724 

-73-7 

2.187 

8.579 

3750.000 

.3555 

74.6 

2.103 

8.983 

3800.006- 

-  . 3946 

-130.4-  — 

2.305 

8.071 

3850.000 

.4078 

12.0 

2.378 

7.790 

3900.000 

.3939 

165.2 

2.300 

8.091 

3950.006 

.4457 

-45.0 - 

2.606  - 

7.016  - 

3999.999 

.4197 

113.2 

-26- 

2.446 

7.542 

««»»«$»«««««««»«»««««»«»««««»»»««««**«*««»»«««»*****««« 


Ualttr  Rccd  Arntr  Institute  sf  Research 
Oepartnsnt  of  Microwave  Research 
Walter- Reed  Aritf- Medical  Center-  — 
Washington,  DC  20112 


SUBARRAY  VERIFICATION 
ELEMENT  •  4 


Measurenent  Datei  i2i54  FM  FRI.,  S  OCT.,  1984 


Calibration  Date  I  llt34  AH  FRI.,  S  OCT.,  1984 


Frequency  811  VSWR  Return 

—  (HHi) - - - - Loss-(d; 


Magnitude  Phase 


--  2000.000 - 

-  .  6498- 

92.2 - 

—  4.712 

2050.000 

.6037 

-113.5 

4.046 

2100.000 

.6259 

33.6 

4.347 

oot 

.  S657 

‘-170  i 

3.606- 

2200^000 

.  5894 

-25!  9 

31871 

2250.000 

.5332 

118.0 

3.285 

2300.000 - 

.4978- 

—  -81.7 - 

-  2.984. 

2350.000 

.4880 

50.5 

2.906 

2400.000 

.3964 

-139.2 

2.314 

24SO.OOO — 

2500.000 

2550.000 

2400.000-  - 

2650.000 

2700.000 

2750.000-  - 


3.743- 

4.384 

4.069 

4.948- 

4.592 

5.462 

6.056- 

6.231 

8.037 

7.502- 

9.694 

9.101 

11.232- 

12.201 

12.907 

16.915- 


2800.000 

.  1786 

-6.3 

1.435 

14.963 

2850.000 

.0810 

162.4 

1.176 

21.835 

2900.008  - 

.  1444 - 

-39.6 - 

i .  337 - 

16.811— 

2950.000 

.0692 

125.7 

1.149 

23.194 

3000.000 

.  1511 

-58.4 

1.356 

16.415 

3050.008  - 

.1081 - 

85.4 - 

1 . 222 - 

19.995 

3100.000 

.1719 

-89.3 

1.415 

15 . 295 

3150.000 

.1688 

38.8 

1.406 

15.453 

3200.008  - 

. 1820 - 

-131.7 - 

1 . 445 - 

14.798- 

3250.000 

.2321 

-3.4 

1.605 

12.686 

3300.000 

.  1891 

165.8 

1.467 

14.464 

3350.000- 

.2807 

-45.6- 

i . 781 - 

11.035- 

3400.000 

.2241 

99.6 

1.578 

12.993 

3450.000 

.3031 

-100.2 

1.870 

10.367 

3500.000 

.2956 

35.5 

1.839 

10.585 

3550.000 

.3023 

-158.0 

1.866 

10.393 

3600.000 

.3490 

-10.9 

2.072 

9.143 

3650.000 

.2971 

140.9 

1.846 

10.541 

3700.000 

.3824 

-63.2 

2.238 

8.351 

3750.000 

.3318 

85.1 

1.993 

9.584 

3808.008 

.3925 

-116.7 

2.298 

8.123- 

3850.000 

.3938 

21.8 

2.299 

8.095 

3900.000 

.3718 

-178.0 

2. 184 

8.594 

3950.008 

.  4352 

-32.7  -  - 

2.541- 

7.227 

Walter  Read  Arny  Institat*  Research 
Departnent  of  Hierowave  Research 
Walter  Reed  Arny  Hedieal  Center 
Washington,  DC  20R12 


SUBARRAY  VERIFICATION 
ELEMENT  •  S 


Date  1 

12iS7 

FN 

FRI. , 

S 

OCT.  , 

1904 

Calibration 

Date  1 

11:34 

AN 

FRI., 

5 

OCT. , 

1984 

Frequency  811  VSWR  Return 

<MHi) - - - — - Loss  (dB 


Naqnitude 

Phose 

9Antt  AAA. 

O  A  4 

a  ACC_ _ 

4  Q7ft _ 

CU  II  V  •  U  VV 

•a/Oo - 

T  V  •  1 

2051. ORR 

.5009 

-114.6 

3.007 

6.005 

210R.RRR 

.5175 

33.2 

3.145 

5.722 

94CA  AAA_ 

7,432 _ 

22R0.RRR 

.4553 

-22.2 

2.672 

6.835 

22SR.0RR 

.3803 

122.8 

2.227 

8.397 

23R0.RR§- 

—  -  .3690 - 

-70.6 - 

2.178 - 

8.658-  - 

235R.RRR 

.3641 

60.8 

2.145 

8.776 

24R0,RR0 

.2921 

-120.4 

1.825 

10.691 

24SR.00t- 

- .3358 - 

-  14.8 - 

2.011 - 

9.478  — 

2S00.0RR 

.2393 

173.7 

1.629 

12.423 

2SSR.RRR 

.2934 

-29.7 

1.830 

10.652 

26RR.0R9 

.2178  - 

108.7-  -  - 

1 . 553 - 

13,258 

26SR.RR0 

.2200 

-75.2 

1.564 

13.153 

2700. RRI 

.1974 

61.3 

1.492 

14.094 

27SR.0Rt- 

-  .1555 - 

-120.3 - 

1.368 - 

16.168  - 

2800.000 

.1906 

27.0 

1.471 

14.396 

2850.000 

.1205 

-157.8 

1.274 

18.382 

2900,000- 

-  . 1926 - 

-14.4 -  - 

1.477  — 

14.308 

2950.000 

.1220 

153.2 

1.278 

18.274 

3000.000 

.2100 

-46.7 

1.532 

13.555 

3050.000 

.1616--  — 

101.7 - 

1.385 - 

15.834  - 

3100.000 

.2295 

-84.7 

1.596 

12.785 

3150.000 

,2348 

49.5 

1.614 

12.586 

3200.000- 

-  . 2388 - 

-130.0 - 

1.627-- 

12.448 

3250.000 

.2935 

3.6 

1.831 

10.647 

3300.000 

.2543 

165.4 

1.682 

11.893 

3350.000- 

-  .3401 - 

-41.8 - 

2.031-  - 

9.369 

3400.000 

.2931 

101.6 

1.829 

10.659 

3450.000 

.3680 

-94.8 

2.164 

8.684 

3500.000 

.3723 

39. S 

2.186 

8.581 

3550.000 

.3681 

-158.6 

2.165 

8.680 

3600.000 

.4209 

-7.8 

2.453 

7.517 

3650.000 

.3748 

140.0 

2.199 

8.523 

3700.000 

.4442 

-61.6 

2.598 

7.049 

3750.000 

.4163 

84.8 

2.426 

7.613 

^OAA  AAA— 

^44^  a _ 

-  2.634 - - 

6.943- 

-  * • - 

•1 1  /  •  s 

3850.000 

.4715 

22.8 

2.784 

6.531 

3900.000 

.4318 

178.6 

2.520 

7,295 

3950.009 

.4980-  - 

-31.8 - 

2.984 - 

6.054 

3999.999 

,4493 

125.4 

2.632 

6.950 

-28- 


UolTcr  Reed  Arny  ZnstitNt«  •#  Rtstarch 
DcportfMnt  af  Hicrawoa*  Research 
Walter  Reed  Arny  Hedical  Center 
Waahinpten,  DC  21112 


SUBARRAY  UaiPZCATION 
ELEMENT  •  « 


12:58 

PH 

FRZ.» 

5 

OCT. , 

1984 

Calibrotion  Datei 

11:34 

AM 

FRZ., 

S 

OCT., 

1984 

Frequency 

/  Mli«  % 

811 

VSUR 

Return 

1  tf  *  ^ 

Magnitude 

Phase 

200R.0tR - 

.6504 - 

-  90.3 - 

4.721 

-  3.736 — 

2051. OOt 

.6108 

-113.2 

4.138 

4.283 

2100. Olt 

.6327 

32.1 

4.445 

3.976 

94eft.  AAA 

4 

1 .  hAt 

4,897 _ 

2200.000 

.6053 

.  -26.4 

4.067 

4.360 

2250.000 

.5409 

119.0 

3.357 

5.337 

2300.000  -  - 

.5214 - 

-80.7-  - 

3.179 - 

5 . 656 — 

2350.000 

.5064 

50.9 

3.052 

5.910 

2400.000 

.4248 

-136.5 

2.477 

7.436 

2450.000- 

. 4518 - 

-1.3 - 

2,648. - 

.  6.901 — 

2500.000 

.3598 

157.2 

2.124 

8.880 

2550.000 

.3985 

-51.9 

2.325 

7.991 

2600.000 

.3152 - 

86.8 - 

1.921 - 

-  10.028 — 

2650.000 

.3042 

-102.6 

1.875 

10.336 

2700.000 

.2789 

32.3 

1.774 

11.090 

99CA  AAA 

<9  AC4 

4e«»  e 

4  C«  A 

13 , 7^0 _ 

2800.000 

.2391 

-13.3 

1.629 

12.428 

2850.000 

.1316 

146.5 

1.303 

17.615 

2900.000 

. 1895 - 

-68.7 - 

1 . 468 - 

-  14.449 - 

2950.000 

.0984 

91.4 

1.218 

20.138 

3000.000 

.1505 

-86.2 

1.354 

16.451 

3050.000 - 

. 0980 - 

44.6 - 

1.217 - 

20.178- 

3100.000 

.  1300 

-105.5 

1.299 

17.724 

3150.000 

.  1319 

12.8 

1.304 

17.592 

3200.000 

. 1365 - 

-136.7 - 

1.316 - 

17.296-  - 

3250.000 

.1855 

-14.1 

1.456 

14.632 

3300.000 

.  1402 

169.2 

1.326 

17.067 

3350.000  - 

. 2375 - 

-58.8 - 

1.628 

-  12.485 — 

3400.000 

.  1723 

99.6 

1.416 

15 . 273 

3450.000 

,2795 

-97.1 

1.776 

11.073 

3500.000 

.2527 

34.9 

1.676 

11.948 

3550.000 

,2875 

-154.4 

1.807 

10.827 

3600.000 

.3202 

-13.0 

1.942 

9.893 

3650.000 

.2887 

143.3 

1.812 

10.790 

3700.000 

.3728 

-65.5 

2.189 

8.571 

3750.000 

.3221 

85.9 

1.950 

9.840 

3808.008 

.3998- 

-119.1 

2.328 

7.980 

3850.000 

.3857 

19.8 

2.256 

8.276 

3900.000 

.3828 

-179.7 

2.241 

8.340 

3958.008- 

.4344- 

-37.8- 

-  2.536- 

7.248 

3999.999 

.3935 

2.297 

8.102 

yoltcr  R«ctf  fkrnf  Institute  •f  Research 
Departnent  ef  Nicrewove  Research 
Ualter-  Reed  Arnp  Hedicol  Ceitter- 
Uoshinpton,  DC  2II12 


8UBMRAY  VERIFICATION 
ELEHENT  •  7 


Date  1 

IP 

PH 

FRI., 

5 

OCT. , 

1984 

Colibratien 

Date! 

lli34 

AN 

FRI. , 

5 

OCT. , 

1984 

Frequencp 
(HHt) - 


2000.001 - 

20S0.000 

2100.000 

21SD.0t0 - 

2200.000 
2250.000 
2300. 00»  - 

2350.000 
2400.000 

2450.000 - 

2500.000 
2550.000 
2600. 00»-- 
2650.000 
2700.000 
2750.000- 


Hognitude  Phase 


.4700— 
.4580 
.4498 
.  4484- 

.4394 

.4264 

.4017- 

.3514 

.3611 

.3383— 

.3261 

.2983 

.2684- 

.2468 

.2092 

.1982- 


9»,1- 

-113.8 

42.1 

-169.4- 

-19.2 

134.9 
-74.4 

92.3 
-127.1 

1S,4- 

173.9 
-40.6 
112.3- 
-93.6 

66.4 
■144.4- 


2.773 - 

2.690 

2.635 

2.627 - 

2.568 

2.487 

2.343 - 

2.083 

2.131 

2.023 - 

1.968 

1.850 

1.734 - 

1.655 
1.529 
1.494 - 


Return 
-Less  (4 


6.558- 

6.783 

6.940 

6.964- 

7.143 

7.404 

7.923- 

9.08S 

8.847 

9.413- 

9.733 

10.506 

11.426- 

12.152 

13.589 

14.058- 


2800.000 

.1675 

23.1 

1.402 

15.521 

1 

2850.000 

.1642 

-177.4 

1.393 

15.691 

-  .  _ 

2900.006 -  - 

.1487 - 

-30.1-  - 

1 . 349 - 

16.556 - 

) 

2950.000 

.1595 

146.7 

1.379 

15.947 

3000.000 

.1715 

-65.3 

1.414 

15.317 

- - - 

3050.000 - 

.1698 - 

105.0 - 

1.409- - 

IS. 400 - - 

) 

3100.000 

.2113 

-103.3 

1.536 

13.503 

3150.000 

AAA 

.2032 

9AAA^ 

51.7 

A^  A,  ~ 

1.510 

1  _ 

13.842 

12  237- 

- - 

•  - 

8  A  1  A 

> 

3250.000 

.2469 

.8 

1.656 

12.151 

3300.000 

.2805 

158.7 

1.780 

11.043 

,  — - 

3350.000-  — 

.2968 - 

-49.9  - 

1 . 844 - 

10.550-  - 

3400.000 

.3019 

102.7 

1.865 

10.404 

J 

3450.000 

.3463 

-106.8 

2.059 

9.211 

3500.000 

.3461 

39.6 

2.059 

9.216 

3550.000 

.3802 

-168.2 

2.227 

8.401 

) 

3600.000 

.3822 

-11.5 

2.237 

8.354 

> 

3650.000 

.3937 

135.9 

2.298 

8.098 

\ 

3700.000 

.4143 

-70.1 

2.415 

7.653 

1 

3750.000 

.4163 

85.6 

2.426 

7.613 

-  .  . 

3800.006 

.4432 

-127.9 

2.592 

7.067 

3850.000 

.4450 

22.0 

2.604 

7.032 

3900.000 

.4540 

171.3 

2.663 

6.860 

3950.006 

.4649- 

-37.2  - 

2.73F  - 

6.654^ 

> 

3999.999 

.4713 

122.7 

-30- 

2.783 

6.533 

i 

1 

l< 

I 


i"*  •••  fcf  t*«  .<i 
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Walter  Reed  ArMf  Inetitete  e#  Reeeorch 
Departitent  of  Hicrewawe  Research 
Walter  Reed  Arnp-Hedical  Center- 
Washinpten,  DC  20112 


SUBARRAY  VERIFICATION 
6  dB  ATTENUATOR  WITH  SNA  A0AFT0R8 


Dote  1 

llt39 

AN 

FRI. , 

5 

OCT. , 

1984 

Calibrotien 

Datei 

11)34 

AN 

FRI.» 

5 

OCT., 

1984 

2000.000- 
2050. 001 
2100.000 
2150.000— 
2200.000 
2250.000 
2300.000 — 
2350.000 
2400.000 
2450.000 — 


Nopnitude 

-  .4964 - 

.4965 

.4976 

—  .4976 - 

.4935 

.4937 

. 4964 - 

.4907 
.4885 
.4922 - 


Phase 


-8.4 

-17.3 

-26t1- 

-35.6 

-44.8 

-53,S- 

-62.0 

-71.0 

-80.4- 


2500.000 

.4932 

-89.5 

2550.000 

.4954 

-98.3 

2600.000- 

.  4929- 

-  -106.5 — 

2650.000 

.4902 

-115.6 

2700.000 

.4919 

-125.0 

97ca  naa 

Aoaa 

.4  'tY  ,  4 

2800.000 

.4978 

-142.1 

2850.000 

.4952 

-151.6 

2900.000-  -- 

.4975 - 

-161.1  — 

2950.000 

.4979 

-169.6 

3000.000 

.4962 

-179.0 

3050.000- 

. 4956 - 

172.0 - 

3100.000 

3150.000 

3200.000- 

3250.000 

3300.000 

3350.000  - 

3400.000 

3450.000 

3500.000 

3550.000 

3600.000 


3650. 

3700. 

3750. 

3800-. 

3850. 

3900. 

3950. 

3999. 


000 

000 

000 

000— 

000 

000 

000- 

999 


.4954 

.4938 

.4938- 

.4929 

.4929 

.  4935 

.4963 

.4933 

.4909 

.5005 

.5011 


.4970 
.  4947 
.4953 
.4968— 
.4964 
.4944 
. 4937- 
.4948 


163.1 

154.4 
145.8- 
136.6 

127.4 
118.2-- 

109.8 

100.9 

91.6 
82.0 

73.7 


64.5 

55.7 

46.7 

37.3— 
28.2 
19.4 

10.3— 
1.5 

-31- 


Insertisn 
-ksss-  (d8>- 


6.079 - 

6.081 

6.062 

6.135 

6,130 

6.083 - 

6.183 

6.223 

6. 157 - 

6.140 

6.100 

6.144  - 

6.193 

6.163 

6.055 - 

6.058 
6.105 
6.064-  - 
6.058 
6.087 

6.098 - 

6.100 
6.129 
6.129  — 

6.145 

6.145 

6.135 - 

6.086 

6.138 

6.  180 
6.012 
6.002 


6.073 
6.113 
6.102 
6.076 — 
6.083 
6.118 
6 1 1 30 
6.111 


Uolttr  Rt«d  Arny  Institute  •f  Rtstarch 
Dsportnent  uf  Hiertuaus  Rsssorch 
Usltsr  Rssd  Arnp  Hsdical  Csntsn 
Uoshinptun,  DC  2QI12 


» 

« 


« 

« 


8UBARRAY  VERIFICATION 

MUTUAL  C0UFLIN6  ELEMENTS  1  TO  2 


Msasurensnt  Dots  i  il:42  AN  FRI.>  5  OCT...  1984 


Colibrotion  Dotsi  lli34AN  FRI.,  S  OCT.,  1984 


Frsqusncp 


821 


Moqnituds 

Phass 

Oiktktk  AAA 

fl  A^4 

A  A 

2050.000 

.0037 

137.6 

2100.000 

.0039 

-84.3 

94CA  HAA.. 

A  A.AA. 

9 

2200,000 

.0050 

-166.0 

2250.000 

.0056 

-28.6 

2300.000- 

.0060 - 

113.1  - 

2350.000 

.0065 

-117.3 

2400.000 

.0070 

27.4 

2450. 00(F 

-  .0073- - 

158.8 - 

2500.000 

.0080 

-60.6 

2550.000 

.0081 

73.1 

2600.000 

.0086  - 

-155. Ir- - 

2650.000 

.0086 

-16.4 

2700.000 

.0086 

120.0 

2750.000- 

-  .0087-  -- 

-107.0 - 

2800.000 

.0083 

32.1 

2850.000 

.0081 

165.6 

2900.000 

.0075 - 

-66.2 - 

2950.000 

.0073 

74.7 

3000.000 

.0067 

-150.9 

3050.008 

-  .0063-  — 

-13.7 - 

3100.000 

.0057 

122.8 

3150.000 

.0052 

-102.6 

3200.008 

.0048 - 

42.9 - 

3250.000 

.0042 

177.3 

3300.000 

.0038 

-43.7 

3350.008 

.0033 - 

94.7 - 

3400.000 

.0029 

-128.6 

3450.000 

.0025 

9.0 

3500,000 

.0021 

145.4 

3550.000 

.  0019 

-76.6 

3600.000 

.0016 

70.3 

3650.000 

.0013 

-150.9 

3700.000 

.0010 

-5.5 

3750.000 

.0009 

138.4 

3800.008 

.0008 

-76.4 

3850.000 

.0007 

62.3 

3900.000 

.0005 

-147.1 

3950.008 

.0005-  - 

-5 ,  t - 

3999.999 

.0004 

144.6 

-32- 

Inssrtion 
-Luss-  (d#^ 


49.968 — 

48.549 

48.104 

44.794 — 

46.019 

45.069 

44.419- 

43.750 

43.112 

42.702— 

41.897 

41.828 

41.263 — 

41.354 

41.314 
41.214 — 
41.652 
41.832 

42 . 475 - 

42.697 

43.422 

43.974— 

44.839 

45.655 

46.343 - 

47.486 
48 . 438 
49.551 
50.647 
52.086 
53.379 
54.310 
55.990 


57.474 
59.850 
60.749 
62.050 
63.504 
65 . 635 
66.260^ 
67. 169 


I. i ■  s.**a  <**  «w>«  •«■  »>>  ♦..> 


%• 

[1 


y«lt«p  Racd  Atmv  Xn«tit«t«  •#  ltc*«arch 
Oaportncnt  of  Micro wawo  Rosoarch 
Uaircr-  Rood  Arnr  Medical  Caator- 
Uaahington..  DC  21112 


k 


e: 


8UBARRRY  VERIFICATION 

MUTUAL  C0UFLIN6  CLEMENTS  1  TO  3 


> 

'i 

Datei  11 >44  AN 

FRX. , 

5 

OCT.,  1984  ! 

1* 

) 

0 

Calibration 

Datei  11>34  AN 

FRX., 

5 

OCT.,  1984 

i 

)  ■ 

Froquencf 
- <MHi> - 

821 

! 

Insertion 

- Loss-  (484 - 1 

Magnitude 


Phase 


2000. OOd— 
2050.000 
2100.000 
2150.  OOR— 
2200.000 
2250.000 
2300.000'- 
2350.000 
2400.000 
2450. OOR- 
2500.000 
2550.000 
2600. OOR 
2650.000 
2700.000 
2750. 000- - 
2800.000 
2850.000 
2900. OOR- 
2950.000 
3000.000 
3050.000- 


.0016 — 
.0015 
.0012 

-.0012 - 

.0010 
.0011 
.0009 — 
.0008 
.0008 
.0007-  - 
.0010 
.  0008 
.0008 — 
.0008 
.0005 
.0007— 
.0005 
.0004 

.0005 - 

.0003 

.0003 

.0008-- 


142.8- 
-89.4 

41.3 

174.8- 
-48.6 

85.3 
-130.3- 

-7.9 
142.6 
-89.0- 
47.6 
-170.4 
-57.0- 
87.0 
-145.2 
-17. »- 
127.3 
-119.2 
24.9- 
147.8 
-85.5 
65.3- 


55.843 - 

56.318 

58.603 

S8.694 - 

60.047 

59.260 

61.041 - 

61.720 

61.930 

63.447 - 

60 . 356 
62.184 

61 . 766 - 

62.166 

65.469 

63.034 - 

65 . 326 
67.623 

65.558 - 

69.925 
70.054 
72.373 - 


3100.000 

.0002 

164.3 

76.177 

3150.000 

.0001 

-48.1 

78.256 

3200.000 - 

.0001 - 

-  53.2 - 

81.517- 

3259.000 

.0001 

-148.6 

81.096 

3300.000 

.0001 

105.3 

82.730 

nAA..  .  . . 

nnne  - 

fl^.  9 

84 . 090 

3400.000 

.0000 

133.9 

89.200 

3450.000 

.0000 

-112.8 

91.249 

3500.000 

.  0001 

3.6 

85 . 727 

3550.000 

.  0000 

165.2 

86.215 

3600.000 

.  0000 

33.0 

100.708 

3650.000 

.0000 

-10.3 

87.401 

3700.000 

.0001 

-174.5 

83.135 

3750.000 

.  0001 

-23.5 

81.749 

3800. OOR 

.0000 

36.1 

90.788 

3850.000 

.  0000 

-168.7 

92.239 

3900.000 

.0001 

-5.8 

83.281 

3950. OOR 

.0060 

-42.3-  -  - 

88.205- 

3999.999 

.0000 

-144.9 

104.294 

-33- 

I 


i 


I 


fc* ■ . 'i'i' 


Walter  Rted  Arnv  Xnatitvt*  •f  fttscarch 
Otportnant  ef  Microwave  Reeeorch 
Walter-  Reed  Aritr  Hedieal  Center- 
WaahinRten,  DC  20112 


8UBMRRY  VaiFXCATION 

MUTUAL  C0UPLXN6  ELEMENTS  1  TO  4 


Datei 

ill  46 

AM 

FRX.  , 

8 

OCT. , 

1984 

Calibratien 

Date  1 

111  34 

AM 

FRX., 

8 

OCT. , 

1984 

Frequency 
(MHs> - 


2000.000- 
2oso.oeo 
2100.000 
21SO.OOO— 
2200.000 
22SO.OOO 
2300.000  - 
23SO.OOO 
2400.000 
24SO.00t- 
2S00.000 
25S0.000 
2600.000 
26SO.OOO 
2700.000 
27SO.OOO- 
2800.000 
28SO.OOO 
2900.000- 
2980. 000 
3000.000 
3080.000 
3100.000 
3180.000 
3200.000- 
3280.000 
3300.000 
3380.000- 


Moqnitude 

-  .0011 - 

.0010 

.0007 

- .0006 - 

.0004 

.0004 

.0003 - 

.0000 

.0001 

-  - .0003 - 

.0003 

.0003 

.0004 

.0004 

.0008 

-  .0008 - 

.0004 

.0006 

-  .0004 - 

.0004 

.0004 

-  .0005- 
.0003 
.0003 

-  .0003— 
.0002 
.0003 
.0002- 


Phoee 

-163.9— 

-42.8 

79.3 
-144-.4— 

-8.2 
121.9 
-91.2— 
103.8 
-62.6 
43-.  6 — 
-171.1 
-81.2 
94.9- 
-121.1 
-6.0 
12S.9- 
'107.6 
38.7 
186.6- 
-70.8 
66.6 
-166.7- 
-28.2 
99.6 
'111.3 

11.4 
144.6 
-76.8  - 


Xneertien 
-Leeo— <  d8>- 


89.110 - 

89.868 

63.421 

64.968 - 

67 . 697 
68.838 

71.298 - 

94.400 

82.244 

70.878  - 

71.878 
70.793 

68.828 - 

67.981 

68.494 

66.009 - 

68.076 
68.122 
67.317 — 
67.748 
67,881 
69.387  - 

69.828 
70 . 382 
71.884-  - 
72.366 
70.639 
73,202 - 


3400.000 

.0002 

81.9 

74.164 

3480.000 

.0001 

-189.3 

77.831 

3800.000 

.0002 

-21.1 

76.419 

3880.000 

.0001 

137.1 

78.831 

3600.000 

.0000 

-128.6 

89.482 

3680.000 

.0001 

-24.8 

81.848 

3700.000 

.  0001 

166.3 

80.697 

3780.000 

.0001 

-60.8 

79 . 896 

3800.000 - 

- .0000 - 

—  160.8 - 

-  86.882 - 

3880.000 

.0000 

186.2 

94 . 877 

3900.000 

.0000 

23.8 

88.364 

3980. OOR 
3999.999 


.0001^ 

.0000 


28.0- 

-104.6 


84.121 — 
86.204 


Miter  Rted  Arnv  Xnstitetc  •#  Rci 
Deportnent  •f  Hlerawave  Research 
Uolter  Reed  Arnp  Hedlcel  Center 
yaehinpten,  DC  21112 


SUBARRAY  VERIFICATION 

MUTUAL  COUfLINC  ELEMENTS  1  TO  S 


Date  i 

lli48 

AN 

FRl., 

S 

OCT.,  1984 

Colibretlen 

Datei 

lli34 

AN 

FRI., 

5 

OCT.,  1984 

Frequency 


821 


(HHi) - 

2000.000 _ 

Magnitude 

_  A  A4  O 

Phase 

4  81.  « 

2050.000 
2100.000 
21S0. 000 _ 

.0011 

.0010 
fia4  « 

A  C - 

-75.5 

55.1 

_4  .>e  a 

«  V  V  8  a 

A  /  yr  y~'  ■  - 

2200.000 

.0008 

-43.5 

2250.000 

.0008 

93.3 

2300.000— 

.0007- - 

-107.3- . 

2350.000 

.0007 

12.8 

2400.000 

.0008 

154.7 

2450.000 - 

--  .0004 - 

-75.7 - 

2500.008 

.0008 

62.2 

2550.000 

.0007 

-152.2 

2600.008 

.0008 

-38.4 - 

2650.000 

.0008 

102.5 

2700.000 

.0004 

-128.4 

2750.000 - 

--  .0007 - 

-6.8 - 

2800.000 

.0004 

145.4 

2850.000 

.0004 

-95.2 

2900.000  - 

--  .0005 - 

33.7 - 

2950.000 

.0003 

159.3 

3000.000 

.0004 

-78.2 

3050.008  - 

-  .0003 - 

77. S - 

3100.000 

.0002 

172.0 

3150.000 

.0002 

-17.4 

3200.000 

.0001 

95.1 

3250.000 

.0001 

-130.3 

3300.000 

.0001 

89.0 

3350.000— 

.0008 - 

142.9 - 

3400.000 

.  0000 

-152.4 

3450.000 

.  0000 

160.8 

Insertien 
Less  <dML. 


58.091- 
58 . 858 
59.587 
58.9»7— 


61 . 656 
62 . 228 

63.554- - 

62.714 

61.778 

64.094 - 

61.754 

63.087 

62.049 - 

61.801 

64.711 

62 . 688 - 

64.965 

67.044 

65.203 - 

69 . 782 
68.514 

71.199 - 

75.647 
74. 172 

79 . 325 - 

80.165 

82.214 

90.294 - 

88.377 

104.649 


3500.000 

.0001 

0.0 

82.911 

3550.000 

.0000 

172.8 

89.097 

3600.000 

.  0001 

18.1 

86.002 

3650.000 

.0001 

5.1 

82.181 

3700.000 

.0000 

-168.3 

84.194 

3750,000 

.0001 

-72.4 

82.980 

3800.000 - 

.0008- 

-142.3- 

87.085 

3850.000 

.  0001 

160.4 

85.408 

3900.000 

.0000 

14.3 

90.294 

3950.008 

.0000- 

-33.5- 

91.203-  - 

3999.999 

.0001 

-68.9 

83.619 

Uolttr  Rtcd  Arnv  Institute  •f  Research 
Dspertnent  af  Micrawaue  Research 
Uolter-  Retd  Hedicel  Ceitter- 

Uashinpton,  DC  20012 


SUBARRAY  VERIFICATION 
NUTUAL  COUPLING  ELEMENTS  1 

TO  6 

Heasurenent  Dote i  lliSO  AH 

FRI. , 

S 

OCT.  , 

1984 

Calibration  Detei  11 >34  AH 

FRI., 

5 

OCT. , 

1984 

Frequency  821  Insertion 

_  <HHs) - — - — — — — — - Lass-(d84 

Haqnitude  Phase 


2000.000--  — 
20S0.000 

.0043^ - 

.0046 

-  -1»t7 - 

123.0 

47 . 429 - 

46.752 

2100.000 

.0005 

-14.9 

66.418 

7140  ftOO 

0052 

43  9 

45.750 - 

2200.000 

.0055 

-176.0 

45.218 

22SO.OOO 

.0062 

-40.1 

44.122 

2300.000  - 

.0064-  —  - 

102.8 - 

43.875-^-- 

23S0.000 

.0068 

-126.0 

43.399 

2400.000 

.0074 

20.9 

42.673 

2450.000  --- 

.0077  - 

ISt.q - 

42.291 - 

2500.000 

.0084 

-67.7 

41.501 

2550.000 

.0082 

66.9 

41.676 

2600.008- 

.0087  - 

-161.4 - 

41.057- 

2650.000 

.0088 

-21.3 

41.130 

2700.000 

.0087 

115.0 

41.172 

2750.000-  - 

.0088 - 

-112.3- 

41.085-  - 

2800.000 

.0082 

27.4 

41.686 

2850.000 

.0081 

161.7 

41.814 

2900.000  - 

.0074 - 

-69.9 - 

42 . 622 — 

2950.000 

.0071 

71.2 

42.964 

3000.000 

.0066 

-154.3 

43.635 

3050.000- 

.0061 - 

-16.7 - 

44.303 - 

3100.000 

.0055 

120.5 

45.124 

3150.000 

.0050 

-104.8 

46.096 

3200.000- 

.0044- 

40.8 - 

47.141 - 

3250.000 

.0039 

176.1 

48.110 

3300.000 

.0034 

-43.8 

49 . 337 

3350.000 

.0029 - 

94.3 - 

50.719 - 

3400.000 

.  0026 

-128.3 

51.703 

3450.000 

.0022 

10.6 

53.335 

3500.000 

.0018 

146.6 

54.909 

3550.000 

.0015 

-71.0 

56.522 

3600.000 

.0013 

78.4 

57 . 982 

3650 . 000 

.0010 

-140.7 

59.945 

3700.000 

.0008 

5.4 

61.654 

3750.000 

.0007 

153.7 

63.153 

3800.000 

.0006 

-59.1 

64.383 

3850.000 

.0006 

80.2 

64.970 

3900.000 

.0005 

-127.5 

66.046 

3950.000 

.0004- 

21.4- 

67.214— 

3999.999 

.0004 

‘71. 

67.706 

I  • 


Walter  Reed  Arne  Institute  e#  Research 
Departnent  of  Hicrewove  Reseorch 
Walter  Reed  Arne  Hedicol  Center^ 
WashinRton,  DC  20112 


SUBARRAY  VERIFICATION 

MUTUAL  C0UFLZN6  ELEMENTS  1  TO  7 


Measurenent  Oatei  iiiSS  AN  FRI.,  5 
Calibration  Datei  11:34  AN  FRl.,  S 


2000.000 — 
2050.000 
2100.000 
2150.000 — 
2200.000 
2250.000 
2300.000 — 
2350.000 
2400.000 
2450.000 — 
2500.000 
2550.000 
2600.000- 
2650.000 
2700.000 

2750.000 - 

2800.000 

2850.000 

2900.000- 

2950.000 

3000.000 

3050.  OOS- 

3100.000 

3150.000 

3200. OOS- 

3250.000 

3300.000 

3350.000 - 

3400.000 

3450.000 

3500.000 

3550.000 

3600.000 


3650.000 
3700.000 
3750.000 
380B.OOO — 
3850.000 
3900.000 
3950.000 — 
3999.999 


Magnitude  Phase 


—  .0018 — 
.0019 
.0018 

-  .0021 - 

.0025 
.0028 
.0033 — 
.0040 
.0045 

-  .0052 — 

.0056 
.0058 

-  .0063-- 

.0063 
.0063 

— .  .0064- 
.0059 
.0058 
.0053 — 


134-.9 - 

-77.8 

77.5 

-134^1 - 

12.7 
158.5 
-53,9 - 

82.5 
-132.5 

14i!3 

-84.9 

47.8  - 

-173.0 

-36.3 

97.6-- 

-121.6 

12.7 

141.9 - 


OCT . ,  1984 
OCT.>  1984 


Insertion 
-Loss-  <d8>- 


54.718 - 

54.501 
55.071 
53^.718 — 
52.143 
51.030 

49.675 - 

48.022 
47.013 
45.757 — 
45.084 
44.745 
43.971  — 
43 . 956 
44.008 

43.873 - 

44.528 
44.785 
45.518-  -- 


.0047 

-76.1 

46.470 

.0044 

58.6 

47.199 

.0037 

--159.4 - 

48.088 - 

.0034 

-21.1 

49.431 

.0031 

115.8 

50.118 

.0026 

-94.7  - 

51.781 - 

.0023 

42.6 

52.668 

.0021 

-175.3 

53.582 

.0017  - 

-28.9 - 

55.271 - 

.0016 

108.7 

55.936 

.0012 

-105.9 

58.261 

.  0011 

34.4 

58 . 898 

.0010 

179.9 

60.138 

.0008 

-26.3 

62 . 229 

.0007 

110.5 

63.640 

.0006 

-99. 1 

64 . 695 

.0005 

52.7 

66.744 

.0004 - 

-157.5 - 

67.115- 

.0004 

-10.4 

68.141 

.0003 

137.1 

69 . 873 

.0004-  - 

-57.6 - 

68,  933— - 

.0003 

90.6 

71 . 254 

f*t**t*ftt*****  f  ********************************* 
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SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEMENTS  2  TO  3 


Moasuronont 

Date  1 

12)11 

PN 

FRI. , 

5 

OCT.  , 

1984 

Calibrotion 

Datoi 

11:34 

AH 

FRI., 

5 

OCT. , 

1984 

Froquoncy 

t  MU«  % 

S21 

Inssr tien 

Loss  (dB> 

—  1  npvx  r  ■  — 

Hoqnitudo 

Phase 

2000.000 - 

-  .0039- 

118.0 - 

48.121 - 

2050.000 

.0041 

-101.4 

47 . 642 

2100.000 

.  0040 

40.7 

47.951 

94en  000 _ 

n  noo _ 

-4  79  i 

47 , 080 _ 

2200.000 

.0045 

-37.4 

46.860 

2250.000 

.0048 

101.2 

46.321 

2300.000 

.0049 - 

-111.7  —  - 

46.164- 

2350.000 

.0051 

21.5 

45.904 

2400.000 

.0055 

168.5 

45.271 

2450.000  - 

.0055 - 

-57.3- - 

45.212—  —  - 

2500.000 

.0058 

84.6 

44.683 

2550,000 

.0058 

-136.6 

44.794 

2600.000 

.0061 

-2.9-  -  - 

44.267 - 

2650.000 

,  0060 

138.7 

44.460 

2700.000 

.0060 

-82.8 

44.450 

2750.000-  - 

.0069 - 

52.2 - 

44.420 -  - 

2800.000 

.0056 

-167.4 

45.003 

2850.000 

.0056 

-30.1 

45.059 

2900. OOB 

.0051  - 

99.4 - 

45 . 85S- 

2950.000 

.0048 

-119.5 

46.338 

3000.000 

.0044 

17.2 

47.083 

3050. oor  - 

.0041- 

155.9- - 

47.757 - 

3100.000 

.0036 

-65.8 

48.783 

3150.000 

.0033 

69.9 

49.614 

3200.009 

.0029— 

-142.7 

50.776 - 

3250.000 

.0026 

-7.5 

51.867 

3300.000 

.0023 

134.5 

52.752 

3350.000 

.0019  - 

-84.3 - 

54.604 - 

3400.000 

.0017 

53.3 

55.407 

3450.000 

.0013 

-168.7 

57.482 

3500.000 

.0011 

-26.7 

58.911 

3550.000 

.0010 

116.0 

60.097 

3600.000 

.0007 

-92.0 

62.531 

3650.000 

.0007 

46.0 

63.309 

3700 . 000 

.  0006 

-172.4 

64.831 

3750.000 

.  0005 

-21.0 

65.852 

3809.009 

.0004 

125.7 

68.543 

- 

3850.000 

.0093 

-82.6 

69.141 

3900.000 

.0002 

53.4 

72.143 

3950.009 

.0002 

-138.0  - 

74 . 823- 

3999.999 

.0002 

14.9 

-38- 

73.033 

t- 


i 

1 
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SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEHENT8  2  TO  4 


>  . 


Heasurenent  Datei  12il4  PN  FRI.,  S  OCT.,  1984 


■1 

I  •- 

i 

■x 

)  ^ 


Calibration  Bate  I  lit  34  AN  FRI.,  5  OCT.,  1984 


Frequencf 

<M«i) - 


S2i 


Moqnitude 


Insertion 
-Loss-  (dM^ 


Phase 


2000.000-  - 
2OS0.000 
2100.000 
21S0. 000 - 

.0013 - 

.0013 
.  0010 
,0010 _ 

—  139,5 - 

-92.9 

30.5 

172  0 

57.807 - 

57.911 

59.580 

2200.000 

.  0009 

-53.5 

61.014 

2250.000 

.0010 

73.6 

59.711 

2300.000- 

.0008 - 

—  -14^.2 - 

—  61.692 - 

2350.000 

.0007 

-21.2 

62,513 

2400.000 

.0008 

131.0 

61,956 

2450.000— 

,0007 _ 

_  -97.5 _ 

63  251 _ 

2500.000 

.  0009 

34.5 

60,957 

2550.000 

.0007 

172.5 

62.860 

2600.004 

.0007 - 

-  -74.0 - 

—  62.769 - 

2650.000 

.  0007 

71.5 

62.580 

2700.000 

.0006 

-156.9 

65.119 

2750 . 000-  . 

.00  07 _ 

_  -32.5 _ 

43  Aoa _ 

2800.000 

.  0005 

109.6 

65.692 

2850.000 

.  0004 

-139.3 

67.842 

2900.000 - 

-  .0005 - 

—  i  ,  5 _ 

-  66.784 - 

2950.000 

.  0003 

124.5 

70.709 

3000.000 

.  0004 

-103.9 

69.050 

3050.000—  - 

-  .0002  - 

-  61.0 - 

-  72.527 - 

3100.000 

.0002 

144.2 

74.426 

3150.000 

.0001 

-52.8 

77.497 

3200.000 - 

.0001  -  - 

48.2 - 

80.580- - 

3250.000 

.0001 

-171.4 

80.909 

3300.000 

.0001 

133.9 

83.568 

3350.000- 

,0000  - 

21.9 - 

87 . 375 - 

3400.000 

.0000 

61.0 

94.159 

3450.000 

.0000 

-74.4 

90.885 

3500.000 

.  0000 

-21,7 

87.324 

3550.000 

.  0001 

163.6 

83.776 

3600.000 

.0000 

-152.7 

88.536 

3650,000 

.0001 

-24.2 

79.464 

3700.000 

.0001 

128.9 

81.267 

3750.000 

.0001 

-73.9 

79.662 

3800.000 

.0000 

59,1 

86.929 

3850.000 

.0000 

89.2 

88.773 

3900.000 

.0000 

-63.0 

86.916 

3950.000- 

.  0001 

31.2 

80.806- 

3999.999 

.0000 

-93.3 

87.060 

a 


;s 

S 


-39- 


ColibratiQn  Datci  11:34 


FRI.,  S  OCT.,  1984 


Frtqutncy 
<HHi) - 


2008.004^- 
20S0,000 
2100.080 
21S0.000— 
2200.080 
22S0.000 
2308.000- 
23S0.008 
2400.080 
2458.000- 
2500.000 
2550.080 
2600.000- 
2650.000 
2700,000 
2758 . 080— 
2800.088 
2850.000 
2900.080- 
2950.000 
3000.000 
3050.000 
3100.000 
3150.000 
3200.000- 
3250.000 
3300.000 
3350.000 
3400.000 
3450.000 
3500.000 
3550.000 
3600.000 


3650. 
370  0. 
3750. 
380Oi 
3850. 
390  0. 
3950. 
3999.1 


Magnitude 


.0016 — 
.0019 
.0016 
.0021 — 
.0020 
.0020 
.0021 — 
.0020 
.0023 
.0021 — 
.0021 
.0022 
.0021 
.0021 
.0020 
.0018 — 
.0018 
.0017 
.0015— 
.0015 
.0012 
.0001 — 
.0011 
.0009 
.0009  - 
.0007 
.0007 
.0006- 
.0005 
.0004 
.0004 
,0004 
.0002 


.0002 

.0002 

.0002 

.0001- 

.0001 

.0001 

.0001 

.0000 


Phose 

66.1— 

-160.7 

-.8 

-  95>8— 
-133.1 
-5.4 
133.8— 
-103.7 

32.3 
161.2— 
-67.8 

61.2 

-168.9- 

-40.2 

96.7 
■139.4- 

-5.7 

127.2 

-115.8- 

23.7 
154.1 

-165.4- 

60.2 

179.6 

-31.9^- 

89.9 

-138.9 

2.1- 

123.9 

-95.8 

29.4 
172.0 
-44.9 


63.3 

-144,5 

-22.3 

135-.7- 

■147.1 

15.2 

-75.1- 

-23.8 

-40- 


Inscr tion 
(d8>- 


56.021 — 

54.567 

56.083 

55.425 — 

53.766 

53.847 

53.515 — 

53.919 

52.853 

53.378— 

53.502 

53.295 

53.673 — 

53.729 

53.990 

55.011 — 

54.886 

55.320 

56.662 

56.552 

58 . 652 

83.570— 

59.162 

60.703 

60.528 - 

63.146 
63.188 
64.757 — 
65.940 
67.479 
68.008 
69.023 
73 . 367 


72.632 
74.755 
73.253 
79 . 225- 
85.927 
79.964 
88. 859- 
86.051 


-■vyr  ini  u^^l^ur»us  FXTWAJ^  rwTwir; 


Walter  Read  Arna  Instituta  •f  Research 
Department  of  Hicrouawe  Research 
Walter  Reed  Arnp  Hedical  Center 
WashinQton,  DC  20112 


SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEMENTS  2  TO  6 


Date  I  12ii7  PN  FRI..  S  OCT 


Calibration  Oatei  lli34  AH  FRI.,  S  OCT.,  1984 


Frequency 
<HHiX - 


Magnitude  Phase 


Insertion 
Loss-  (dSX- 


2000.000-  - 

—  .0021 - 

164^.0 - 

2050,000 

.0025 

-59.5 

2100.000 

.0  027 

72.9 

2150.000 - 

0032 

_4C1  -9 

2200.000 

.0  035 

M  ^  “ 

-20.0 

2250.000 

.0041 

107.9 

2300.000- 

-  .0043 - 

-115.5-  - 

2350.000 

.0045 

7.0 

2400.000 

.0049 

146.9 

2450.000- 

—  .0050 - 

-87.3. 

2500.000 

.0054 

46.4 

2550.000 

.0053 

175.4 

2600.  00O-- 

. 0055 - 

-55. 9- - 

2650.000 

.  0052 

76.9 

2700,000 

.0053 

-150.2 

2750.000 — 

—  .0053 - 

-21.1 - 

2800.000 

.  0050 

111.0 

2850.000 

.  0049 

-115.5 

2900.000 

.0044 - 

7.3 - 

2950.000 

.0045 

142.9 

3000.000 

.0040 

-85.7 

3050.000 - 

--  .003G - 

44.7 - 

3100.000 

.0035 

178.8 

3150.000 

.0031 

-51.5 

3200.000 

.0030— 

88.3 

3250.000 

.  0014 

-89.9 

3300.000 

.0  023 

-8.9 

3350.000 

-  .0020-- 

126.3 - 

3400.000 

.0018 

-104.6 

3450 . 000 

.  0016 

28.7 

3500.000 

.0013 

160.6 

3550.000 

.  0012 

-64.6 

3600.000 

.0010 

76.4 

3650.000 

.  0008 

-149.2 

3700.000 

.0007 

-10.1 

3750.000 

.  0004 

126.9 

3800.000- 

.0  005- 

-91.4- 

3850.000 

.0004 

36.7 

3900.000 

.0003 

-174.2 

3950.000- 

.0003 - 

-49.2 - 

3999.999 

.0003 

110.9 

- - 

-  - 

-41- 

•  r  “VJi  ■\j*  ■  M  “  Ji  ~.jt 

"-m  •  -w*  -.r  ^ 

53.754- 

52.017 

51 . 472 

49.894- 

49.081 

47 . 684 

47 . 239- 

46.928 

46.258 

45.975- 

45.353 

45.522 

45.150— 

45.624 

45.452 

45. 68^- 

45.990 

46.220 

47.177- 

46.974 

47.904 

48.364- 

49.131 

50.254 

50.592- 

56.094 

52.775 

53.820- 

54.963 

56.001 

57.913 

58.500 

60.304 


61.486 
63.314 
64.763 
65 . 633 
67.100 
69.122 
69.361 
71.915 


I 


c  w 


1} 


)  - 


U«lt€r  Rc«d  Arny  Znstitut*  Rtscorch 
Department  of  Hicrewave  Reseorch 
Walter  Reed  Arnp  Hedical  Ceitter- 
Washingten>  DC  20112 


SUBARRAY  VERIFICATION 

NUTUAL  COUPLING  ELEHENT8  2  TO  7 


Heaeurenent 

Date  t 

12il8 

PH 

FRI., 

S 

OCT. , 

1984 

•A 

Calibration 

Date  1 

ilt34 

AH 

FRI., 

s 

OCT.  , 

1984 

Frequency 


S2t 


Ineertion 


(HHi) - 

Hoqnitude 

— _ _ 

Phase 

-Less-  <dBi - 

2000.000 

i  0032 

-18,3 

49  980 

2050.000 

!6o36 

122!  7 

48.933 

2100.000 

.0042 

-96.5 

47.567 

2150 . 000 

0047 

34 . 

4^  Sftl 

2200.000 

.0052 

17Z.7 

45 . 660 

2250.000 

.0056 

-49.3 

45.033 

2300. 00» 

.0059 - 

90.7- 

44.620 - 

2350.000 

.0063 

-138.3 

43.953 

2400.000 

.0067 

5.1 

43.535 

2450.000 _ 

. 0069- 

135  4 

43  230 

2500.000 

.0072 

-82.5 

42^822 

2550.000 

.0073 

50.2 

42.757 

2400.000- 

.0079  - 

-175.9 - -  - 

42.267  - 

2650.000 

.0076 

-38.6 

42.421 

2700.000 

.0  075 

98.3 

42.478 

2750.000- -  -- 

-  .0075- 

-128.9 

42.501  - 

2800.000 

.0071 

10.3 

42.915 

2850.000 

.0070 

144.6 

43.040 

2900.000  - 

-  .0064 - 

-87.  t - 

43 . 874^  - 

2950.000 

.0063 

53.1 

44.056 

3000.000 

.0058 

-171.7 

44.746 

3050.000 - 

.0053 - 

-35.5 - 

45.443 - 

3100.000 

.0049 

101.4 

46.164 

3150.000 

.0044 

-124.7 

47.129 

3200.000- 

.0040 

20.6 - 

47 . 868 - 

3250.000 

.0035 

155.8 

49.095 

3300.000 

.0031 

-67.0 

50.161 

3350.000- 

.0027  - 

72.4 - 

51.255 - 

3400.000 

.0024 

-151.8 

52.544 

3450.000 

.0020 

-15.3 

53.787 

3500.000 

.0017 

123.0 

55.430 

3550.000 

.0015 

-99,7 

56.380 

3600.000 

.0013 

49.5 

57.931 

3650.000 

.0010 

-171.1 

59.866 

3700.000 

.0008 

-32.3 

61.960 

3750.000 

.0007 

117.1 

63.200 

3800.000 

.0006 

-99.1 

64.468 

3850.000 

.0005 

36.9 

65.231 

3900.000 

.  0004 

-170.1 

68.505 

3950.000 

.0004 

-19.7 

68^351- 

3999.999 

.0003 

127.3 

70.269 

-42- 

r^i 


,1 


a 


'i 


I 


k 


I 
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SUBARRAY  VERIFICATION 

MUTUAL  COUFLING  ELEMENTS  3  TO  4 


M«a»ur«n«nt  Dat«i  i2t2R  FN  FRI.,  S  OCT.,  1984 


Callbratlan  D«t«t  11:34  AN  FRI.,  5  OCT.,  1984 


Fraquancf 
-  <NHz) — 


S21 


Inscrtlan 


Maqnitttd*  Phas« 


2000. 0Q4-- 
20SO.OOO 
2100.000 

2150 . OOt _ 

-  .0047 - 

.0054 

.0054 

AflAt 

- 37.3 - 

104.0 

-118.3 

4  B  a 

46.512 - 

45 . 335 

45.412 

A  A  tAC 

2200.000 

.  0063 

159.1 

44.016 

2250.001 

.  0069 

-65.3 

43.166 

2300.000 - 

.0073 - 

-  78.1 - 

42.718 - 

2350.000 

.0076 

-153.7 

42.374 

2400.000 

.0081 

-7.6 

41.832 

2450.000 - 

1  0082 

i 

44  7?4 

2500.000 

.0  088 

-96.7 

41.107 

2550.000 

.  0086 

38.1 

41.280 

2600.000-  - 

.0098  - 

-  169^5 - 

40.900 - 

2650.000 

.0088 

-50.5 

41 . 146 

2700.000 

.0085 

86.2 

41.394 

2750.000 - 

.0084 - 

-140.5 - 

41.464 - 

2800.000 

.0078 

-.9 

42.109 

2850.000 

.0078 

133.8 

42.197 

2900.000^ - 

.0070- 

-97.7 . 

43.088 - 

2950.000 

.0067 

43.9 

43.428 

3000.000 

.0062 

179.6 

44.191 

3050.008 

.0057- 

-42.7 - 

44.884 - 

3100.000 

.0052 

95.8 

45.744 

3150.000 

.0046 

-130.3 

46.758 

3200.000 

.0042 

16.1  - 

47.518- 

3250.000 

.  0036 

150.9 

48.825 

3300.000 

.  0033 

-69.1 

49.705 

3350.000— 

.0028 

71.8 - 

51.035— 

3400.000 

.0025 

-152.0 

52.009 

3450.000 

.0021 

-13.0 

53.401 

3500.000 

.  0018 

123.3 

54 . 886 

3550.000 

.  0016 

-95.8 

55.975 

3600.000 

.0013 

54.7 

57.482 

3650.000 

.0012 

-167.4 

58.676 

3700.000 

.0009 

-20.1 

61 . 135 

3750.000 

.  0009 

122.7 

61 . 190 

3800-.000 - 

. 0007 - 

-98.5 - 

62.980—  - 

3850.000 

.  0006 

51.2 

64.834 

3900.000 

.  0005 

-163.4 

66.194 

3950.008 

.  0008 

-13n6 - 

66. 115- 

3999.999 

.0004 

137.5 

67 . 588 

-43- 

I 


ltalt«r  Rc«d  Arny  Institute  sf  Research 
Oeportnent  of  Hicrewave  Research 
Uolter  Reed  Arnp  Hedical  Center 
Washington,  DC  20112 


SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEMENTS  3  TO  S 


Date  1 

12:21 

FN 

FRI., 

S 

OCT. , 

1984 

Calibration 

Dote  1 

11:34 

AH 

FRI., 

5 

OCT., 

1984 

Frequencf 


Insertion 


1  ,f 

(HHi) - 

Magnitude 

Phase 

Less  (dB.) - 

\ - 

2000.000— 

-  .0027 - 

155.9  - 

51.415- 

!  ’  ■ 

2050.000 

.0032 

-70.4 

49.935 

2100.000 
2150.000 _ 

.0033 

. 0037 - 

.0039 

63.6 

49.553 

1  >  ■ 

H  _ 

A 

22o6!ooo 

***109  •  m - 

-29.8 

48.108 

2250.000 

.0044 

102.5 

47.040 

2300.000^  - 

,0048 - 

- -121.4- 

46.389-  - 

i  . 

2350.000 

.0050 

3.0 

46.093 

2400.000 

.0052 

141.9 

45.716 

1  - 

2450.004- 

-  .0054 - 

-91. Ir- - 

45.336— 

L  )  ■ 

2500.000 

.0057 

43.7 

44.852 

2550.000 

.0055 

172.5 

45.152 

S  - -  . 

2600.000- 

.005» 

-59.2 

44.720 

2650.000 

.0055 

74.3 

45.266 

2700.000 

.0055 

-152.1 

45.179 

2750.000- 

-  .0058  — 

-22.6 - 

45.518 - 

) 

1 

2800.000 

.0051 

110.5 

45.920 

2850.000 

.0049 

-116.5 

46.194 

,  - 

2900. 004 

.0044-  - 

7,5 _ 

47.142 - 

0 

*  ) 

2950.000 

.0043 

142.8 

47.277 

3000.000 

.0039 

-86.1 

48.187 

- -  -  - 

3050.000- 

-  .0036 

46,5 - 

48.804 - 

) 

3100.000 

.0033 

179.5 

49.721 

3150.000 

.0029 

-50.2 

50.773 

- - -  — 

3200.000 

.0026  - 

89.8- 

51.606 - 

!  > 

3250.000 

.0023 

-136.9 

52.732 

3300.000 

.0020 

-3.4 

53.919 

,  ■  - - - 

3350.004  - 

.0018- 

130.6 - 

54.956  - 

3400.000 

.0015 

-97.0 

56.243 

3450.000 

.0013 

34.9 

57.412 

3500.000 

.0010 

170.7 

59.941 

) 

3550.000 

.0009 

-56.6 

60.547 

> 

3600.000 

.0008 

85.2 

61.672 

3650.000 

.0007 

-131.8 

63.662 

> 

3700.000 

.0005 

7.5 

65.359 

3750.000 

.0004 

145.6 

67.156 

3800.004 

.0004 

-72.3- 

68.901 

3850.000 

.0003 

62.3 

69.472 

3900.000 

.0003 

-154.0 

71.657 

'  '  - 

3950.004 

.0003^ - 

-17.1 - 

71.280- 

3999.999 

.0002 

147.5 

73.401 

« 


« 

« 

« 

« 

« 


Wolttr  R««d  Armf  Xnstltwta  Rcstarch 
DcpartiMnt  of  Hierowowc  RcMorch 
Wolttr-  Rcod  tkrmt  Hcdicol 
Washington,  OC  20112 


*- 

« 

« 


SUBARRAY  VERIFICATION 

HUTUAL  C0UFLIN6  ELEMENTS  3  TO  & 


•s: 


It  Oottt  12:23  PN  FRI.,  5  OCT.,  1984 


Calibration  Bata:  11:34  AM  FRI.,  5  OCT.,  1984 


■•1' 


.-I 

)  - 


Froquancf 
<MMi) - 


S21 


Hognitud*  Phasa 


2000.000 - 

.0024 - 

-  44. 1 - 

2050.000 

.  0027 

-179.6 

2100.000 

.0025 

-54.3 

OAS 

n  Aoo 

•»0  A 

2200.000 

.0026 

-155.9 

2250.000 

.0  025 

-29.6 

2300.008- 

.0025 - 

111.6 - 

2350.000 

.0024 

-126.3 

2400.000 

.0026 

12.5 

2450.000-  -- 

.002X- 

-  142.5— 

2500.000 

.0  023 

-86.4 

2550.000 

.0023 

44.6 

2600.008-  - 

.0021 - 

174.4 - 

2650.000 

.0022 

-55.9 

2700.000 

.0028 

80.5 

2750.000 - 

.0018 - 

-153.5 - 

2800.000 

.0018 

-19.1 

2850.000 

.0017 

114.3 

2900.008 - 

.0015 - 

-128.7^ - 

2950.000 

.0015 

12.3 

3000.000 

.0012 

141.9 

3050.008-  - 

.0012 - 

-89.2 - 

3100.000 

.0011 

50.9 

3150.000 

.0010 

170.0 

32il0.008- 

.0009 - 

-43.5 - 

3250.000 

.0007 

83.0 

3300.000 

.0007 

-151.4 

3350.008- 

.0006--  - 

-8.i - 

3400.000 

.0005 

118.8 

3450.000 

.  0003 

-112.4 

3500.000 

.0003 

25.1 

3550.000 

.0003 

156.4 

3600.000 

.0002 

-37.0 

3650.000 

.0002 

59.4 

3700.000 

.0002 

-149.2 

3750.000 

.0001 

-18.1 

3800.008 

.0001 

139.8 

3850.000 

.0001 

-85.0 

3900.000 

.  0001 

40.9 

3950.008- 

.0008- 

-132.7  - 

3999.999 

.  0001 

-70.6 

-45- 


Insartion 
-Loss-  (d#>- 


52.2S4— 

51.431 

51.924 

50.699l_ 

51.759 

51.993 

51.907- 

52.521 

51.812 

52.84i- 

52 . 633 

52 . 767 

53.366- 

53.281 

53.982 

54.740— 

54 . 766 

55.226 

56.514— 

56.493 

58.095 

58.199-- 

59.392 

60.385 

61.405— 

63.334 

63.023 

64.933- 

65.961 

69.295 

69.655 

69.811 

74.500 


A 


74.835 
74 . 364 
80.079 
78.713 
85 . 396 
81,558 
93.228- 
83 . 697 


r  » 


Walter  Read  Arny  Znstitvta  tf  Rasearch 
Dapartnant  of  Nicrowova  Roaaarch 
Walter-  Reed  Arny  Hedical  Center 
Waeliington,  DC  20012 


SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEHENT8  3  TO  7 


Heoeurenent 

Oatei 

12i24 

PH 

FRl. » 

S 

OCT. , 

1984 

Calibratien 

Dates 

11134 

AN 

FRl., 

s 

OCT. , 

1984 

Frequency 
<HMi) - 


2000.000-- 
2050.000 
2100.000 
2150.000— 
2200.000 
2250.000 
2300.000- 
2350.000 
2400.000 
2450.  OOB— 
2500.000 
2550.000 
2600. 000-- 
2650.000 
2700.000 
2750.000— 
2800.000 
2850.000 
2900.000- 
2950 . 000 
3000.000 
3050.000- 


Noqnitude  Phoee 


.0045-- 

.0050 

.0053 

.0059 — 

.0062 

.0065 

.0067-  - 

.0070 

.0073 

.0076 - 

.0077 
.0078 
.008t  — 
.0079 
.0078 

.  0077 - 

.0072 

.0071 

. 0065 - 

.0062 
.0  057 
.005^— 


-3S.7— 

104.4 

-115.0 

21.2— 

158.1 
-65.3 

7fr.  3— 
-150.6 
-6.7 
123,9— 
-94.6 

39.8 
173.3  - 
-48.2 

89.3 

-137.2— 

2.9 

137.1 
-93.1- 

46.9 
-178.1 

-39.8— 


3100.000 

.  0048 

96.7 

3150.000 

.0042 

-127.8 

3200.000 - 

.0038— 

-  17.5- 

3250.000 

.0033 

153.0 

3300.000 

.0028 

-68.0 

3350.008- 

.0025 

72.5- 

3400.000 

.0021 

-150.0 

3450.000 

.0019 

-12.6 

3500.000 

.0015 

125.0 

3550.000 

.0013 

-94.3 

3600.000 

.  0011 

57.0 

3650.000 

.0008 

-164.9 

3700.000 

.  0006 

-13.1 

3750.000 

.0005 

137.7 

Ineertien 
-Leee-  (d21- 


4B.886 - 

46.030 

45.595 

44.642 - 

44.083 

43.808 

43.532-- 

43.137 

42.764 

42.419- 

42.219 

42.199 

41.815 

41.994 

42.152 

42.290 - 

42 . 886 

42.963 

43.728  - 

44.202 

44.891 

45.684- 

46.443 

47.495 

48.350- 

49.624 

50.936 

52.158— 

53.519 

54.626 

56.770 

57.871 

59.462 


3808.000- 

3850.000 

3900.000 

3950.000- 

3999.999 


.0005— 
.0005 
.0004 
.0004 — 
.0003 


-72.9 - 

68.0 

-144.8 

-  5.8 - 

162.3 

-  46- 


61.717 
64.169 
65.510 
65.797- 
66.592 
68 . 288 
68.980- 
70.696 


)  .< 


)  ' 


>  ' 


Fr«qu«ncf 
<HMi) - 


S2i 


Instr tien 
-Las*- 


Hoqnituds  Phase 


2000.001 - 

20S0.000 

2100.000 

2150  000 

.0041 - 

.0044 
.  0043 
j  0051 

-30,3 - 

109.2 

-110.4 

29. 1 

-  47.838 - 

47.159 

47.370 

45  5f6 

2200.000 

.0053 

168.5 

45.459 

22S0.000 

.0059 

-55.3 

44 , 598 

P:tAII .  AAtt. 

ft9 .  i 

44  179 

23S0.000 

.  0066 

-140.1 

43.570 

2400.000 

.  0073 

5.2 

42.759 

24SO.OOO- 

.0(174 

iZ4tB _ 

42  580 

2soo!oo6 

.  0080 

-as!  4 

41.898 

2S50.000 

.0079 

49.5 

42.101 

2600.000 - 

. 0083 - 

-179.8 - 

41.570- 

2650.000 

.0082 

-40.0 

41.685 

2700.000 

.  0080 

96.1 

41.910 

2750 ,000 _ 

.0080— 

— -130.7— 

41.978— 

2800.000 

.0074 

8.4 

42.611 

2850,000 

.0  073 

142.2 

42.736 

2900.000^ 

-  . 0066 - 

-88.6- - 

—  43.657 - — 

2950.000 

.0063 

51.4 

44.070 

3000.000 

.0056 

-173.5 

45.051 

3050.000 - 

.0052-- 

-35.6-  - 

45.620 - —  - 

3100.000 

.0046 

102.0 

46.667 

3150.000 

.0041 

-123.7 

47.819 

3200,000- 

.0037-- 

23.4 - 

48.704- 

3250.000 

,  0032 

150.3 

50.024 

3300.000 

.0  020 

-61.9 

50 . 987 

3350.000- 

.0023— 

80.4 - 

-  52.641 - 

3400.000 

.0021 

-144,3 

53.633 

3450.000 

.0017 

-3.4 

55.214 

3500.000 

.  0014 

135.3 

57.019 

3550.000 

.0012 

-83.2 

58.234 

3600.000 

.0011 

66.2 

59.545 

3650.000 

.0009 

-153.6 

61.340 

3700.000 

.0007 

-3.6 

63.481 

3750.000 

.  0006 

142.7 

64.823 

3800.000 

.  0000 

-74.0 

65.231 

3850.000 

.0005 

75.7 

66.540 

3900.000 

.0004 

-134.3 

67.990 

3950.000- 

.  0004- 

7.9  - 

68.397 

3999.999 

.  0001 

-133.7 

76.503 

-47- 

I 


)  • 


*«««*$»$$««««*«»*««»««*««*««»*««««*«««*««««**»«*««*«««« 

•  Uolt«r  Rccd  Arny  Institute  sf  Rtsuarch  t 

«  Dtpartnsnt  of  Hicrowsvs  Rsssorch  t 

•  Walter-  Retd  Arny-  Hedieal  Ceitter-  - 

«  Washington,  DC  20012  • 

«  * 


•  > 

) 

SUBARRAY  VERIFICATION 
HUTUAL  COUPLING  ELEHENT8  4 

TO  6 

1 

)  ■ 

Heasurenent  Datei  12:28  PH 

FRI., 

5 

OCT.  , 

1984  ^ 

4 

)  ■' 

■i 

Calibrotion  Date:  11:34  AH 

FRI. , 

5 

OCT. , 

1984  S 

Frequency 
(HHi ) - 


S2i 


Insertion 
-kes»  (d»>- 


Haqnitude 


Phase 


2000.000- 
2050,000 
2100.000 
2150,000- 
2200.000 
2250.000 
2300.000^  - 
2350.000 
2400.000 
2450.000- 
2500.000 
2550.000 
2600. OOD 
2650.000 
2700.000 
2750.000— 
2800.000 
2850.000 
2900.000- 
2950.000 
3000.000 
3050.006 
3100.000 
3150.000 
3200.000- 
3250.000 
3300.000 
3350.000- 
3400.000 
3450.000 
3500.000 
3550.000 
3600.000 


.0014- 

.0015 

.0013 

.0012 


.0009 

.0008 

.0007 


50.985 - 

56.447 
57 . 979 
58.119 — 
60.932 
61.929 
62.533— 
62.116 
62.338 
65.577 — 
62.225 
64.087 

62.766 - 

63.303 
66.941 
64,403 - 


66.105 

68,779 

66 . 623- 

71.548 

70 . 785 

73.714- 

75 . 873 

75.185 

82.204- 

79.360 

78 . 237 

87.780- 

88.305 

83.490 

83.905 

83.842 

90.621 


3650.000 

3700.000 

3750.000 

3800-.000 — 

3850.000 

3900.000 

3950.000- 

3999.999 


.0000 

.0001 

.0001 

.0000- 


.  0000 
.0000 
.0001 
.0001 


-9.5 

174.4 

-75.4 

-12.2- 

131.6 

-58.2 

60.2- 

-73.4 

-48- 


86.955 
83.562 
85.368 
9t.l7S— 
89.181 
88 . 485 
84^297 — 
85 . 283 


ft.* 


«*«««*$«««»«*«**«»«««««««««««««««««««««*«$«««««««««««: 

Uolttr  Reed  Arny  Institute  sf  Rsssarch 
Deportnent  of  Hicrowavs  Research 
Walter  Reed  Arnr  Medical  Center  ~  .  i 

Uashinaton,  DC  20012 


SUBARRAY  VERIFICATION 

MUTUAL  COUPLING  ELEMENTS  4  TO  7 


9 

I 

y 

!*• 

•<* 


Measurenent  Oatei  12i2S  PH  FRI.,  S  OCT.,  1984 
Calibration  Oatei  11:34  AN  FRl.,  5  OCT.,  1984 


Frequencf 
(HHs) - 


2000.000-- 
20S0.Q00 
2100.000 
2150.000— 
2200,000 
2250.000 
2300.000  — 
2350.000 
2400.000 
2450.000- 


Moqnitude  Phase 


.0019- 
.0022 
.0021 
. 0024 — 
.0028 
.0033 
,  0038— 
.0043 
.0048 
.0054--- 


123.8- 

-89.5 

60.5 

-158.7- 

-6.2 

139.0 

-77.4- 

56.0 

-157.1 

-2S.A- 


2500.000 

.0060 

115.9 

2550.000 

.0060 

-109.7 

-  --  --  2600,004 

.0064- 

22.4-  - 

2650.000 

.  0064 

163.0 

2700.000 

.  P7^a  noA 

.  0062 
n  n  4.  A 

-60.6 

2800.000 

.0058 

-145.9 

2850.000 

.0056 

-10.7 

2900.004- 

.0052 — 

—  119.1 - 

2950.000 

.  0047 

-99.1 

3000.000 

.0043 

36.4 

. .  3050.004 - 

.0038— 

178.2 

3100.000 

.  0033 

-43.1 

3150.000 

.0030 

95.0 

-  3200.000 - 

.0026  - 

-  -114.8-  — 

3250.000 

.  0023 

21.2 

3300.000 

.0021 

166.0 

3350.000 - 

.  0017^- 

-50.1 - 

3400.000 

.  0016 

89.0 

3450 . 000 

.  0013 

-126.9 

3500.000 

.  0012 

13,4 

3550.000 

.  0010 

157.9 

3600.000 

.  0009 

-47.4 

3650.000 

.0008 

92.9 

3700.000 

.0007 

-120.3 

3750.000 

.0006 

28.6 

-  3800.004- 

.0005- 

177.7 

3850.000 

.0005 

-45.6 

3900.000 

.0004 

102.1 

-  3950.004 

.0004-^ 

-91.8 - 

3999.999 

.0003 

51.3 

-»i9- 

Inser tion 
-Lass-  <d8X. 


54.556 — 

53.329 

53.411 

52,506 — 

51.174 

49.554 

48 . 360 - 

47.284 
46 , 459 

45.410 - 

44 , 466 

44.501 

43.927- 

43.944 

44.142 

43.936 - 

44.738 

45.076 

45 . 675 - 

46.620 
47 . 425 

48.375 - 

49.599 

50.320 

51.809 - 

52.814 

53.524 

55.471— 

55.956 

57.530 

58.444 

59.644 

61.373 


61.782 
62.810 
64.062 
66.373 
66.185 
67 . 386 
68.892 
70.393 


Ualt«r  Retd  Arny  Institute  ef  Research  « 
Oeportnent  of  Hicrowave  Research  • 
Ualten  Reed  Arnp  Nedical  Center  -  *■ 
Washington,  DC  20112  * 

« 


SUBARRAY  VERIFICATION 

HUTUAL  COUPLING  ELEMENTS  5  TO  6 


Heasurenent  Date:  12:29  PM  FRI.,  5  OCT.,  1984 
Calibration  Date:  11:34  AM  FRI.,  5  OCT.,  1964 


Frequency  S21  Insertion 

(HHi) - - - - - - Loss-  <d*A 


Magnitude 

Phase 

2000.000 - 

—  .0044 - 

115.4 - 

47.098— - 

2050. 000 

.0046 

-98.3 

46.812 

2100.000 

.0042 

42.4 

47 . 454 

9iaa  oee _ 

nfiAB 

--174^1 

46 . 455- 

2200.000 

«  U  U 

.0045 

-32.7 

46.990 

2250.000 

.  0049 

108.4 

46.200 

2300.000 

-  .0051- - 

-101.1  - 

45.928-  -  - 

2350.000 

.0054 

30.2 

45.401 

2400.000 

.0058 

178.0 

44 . 683 

2450.000 

.0054 - 

-25.1 - 

45.367  -  — 

2500.000 

.0064 

95.2 

43.943 

2550.000 

.0063 

-126.8 

44.042 

2600.000 

.0067 

6.0 

43.483 - 

2650.000 

.0066 

148.3 

43.668 

2700.000 

.0065 

-73.8 

43.734 

2750.000--  - 

,0066 - 

61.9 - 

43.671 - 

2600.000 

.  0061 

-158.1 

.  44.279 

2850.000 

.0061 

-20.6 

44.356 

2900.000  - 

.0055 - 

108.4 - 

45.257- 

2950.000 

.0052 

-110.9 

45 . 679 

3000.000 

.0046 

25.0 

46.669 

3050.000- - 

.0043 - 

164.7 - 

47 . 279 - 

3100.000 

.0037 

-56.6 

48 . 582 

3150.000 

.0034 

77.9 

49.417 

3200.000 

.0029^ 

-132. » 

50,738 - 

3250.000 

.0025 

2.7 

52.116 

3300.000 

.0023 

145.2 

52 . 856 

3350.000-  - 

.0018- 

-72.8 

55.014-  - 

3400.000 

.0016 

65.0 

56.107 

3450.000 

.0012 

-150.7 

58.298 

3500.000 

.  0011 

-11.8 

59 . 495 

3550.000 

.  0009 

138.1 

61.118 

3600.000 

.  0007 

-69.8 

63.381 

3650.000 

.0006 

68.3 

64.009 

3700.000 

.0005 

-142.2 

65.613 

3750.000 

.0004 

8.5 

67.881 

3600.000^ 

.0003 

161.9 

69.328 

3850.000 

.0003 

-51.4 

69.574 

3900.000 

.0003 

90.1 

70.755 

3950.000- 

.0002-  - 

-93.6  - 

72.612 

3999.999 

.0002 

■ 

73.499 

***^^**t*t*tt1^*******t*tt***9*1^*9t99*9********»******^t9 

■  *  -  -  -  .  _  *_ 

*  Walter  Reed  Arnf  Institute  ef  Research  • 

*  Departnent  of  Hlcrewave  Research  9 

t  Uolter-  Reed  Arwf  Medical-  Ceivter-  — - •- 

*  Washington,  DC  20912  9 

*  » 


SUBARRAY  VERIFICATION 

MUTUAL  COUFLINO  ELEMENTS  S  TO  7 


Heasurenent  Oatei  I2i31  FN  FRI.,  S  OCT.,  19B4 
Calibration  Date >  lit 34  AH  FRI.,  5  OCT.,  1984 


Frcquencf 
<MHi) - 


2000. 000-- 
20SO.OOO 
2100.000 
21S0. 000— 
2200.000 
22SO.OOO 
2300.000- 
23SO.OOO 
2400.000 
2450.000- 
2500.000 
2550.000 
2600.000 
2650.000 
2700.000 
2759. OOS 
2800.000 
2850 . 000 
2900.000 
2950.000 
3000.000 
3050.000 
3100.000 
3150.000 
3200.000- 
3250.000 
3300.000 
3350.000 
3400.000 
3450 . 000 
3500.000 
3550.000 
3600.000 


Maqnitude  Phase 


3650. 

3700. 

3750. 

3800. 

3850. 

3900. 

3950. 

3999. 


.000 
.000 
.000 
.000- 
.  000 
.000 
ooo 

.999 


.0039— 
.  0046 
.  0047 
.0050— 
.  0053 
.0  059 
.0063-- 
.  0067 
.0069 
.0072— 
.0  077 
.0077 
.0081 — 
.0080 
.  0078 
.0079 — 
.  0073 
.  0072 
.  0065- 
.  0062 
.0057 
.0052 — 
.  0047 
.0041 
.0  037-- 
.  0032 
.0  028 
.  0024- 
.  0021 
.  0017 
.  0015 
.  0013 
0010 


.  0009 
.0007 
.  0006 
.  OOOfr 
.  0005 
0004 
.  0004 
0003 


- 23,5- 

115.8 
-105.7 

- 36,4- 

171.6 
-49.3 
--  91.4- 

-137.5 
7.2 

—  138,»- 
-79.8 

54.0 

—  -174.6- 

-34.8 

101.8 

—  -125.4- 

14.4 
147.9 
-83.6 

57.4 
-168.1 

-29.8- 

106.4 

-118.6 

28.6- 

163.1 
-56.6 

83.1- 

-139.5 

-.1 

138.1 
-82.4 

69.2 


-147.9 

0.0 

149.2 

-70.6 

76.9 

-130.4 

12.4 

170.7 

-5.1- 


Inscr tion 
-Less-  (d86 


48.108 — 

46.804 

46 . 528 

45.936— 

45.518 

44.612 

44.029 

43.533 

43.226 

42.896 — 

42 . 256 

42.282 

41,836— 

41.977 

42.112 

42.089 — 

42 . 683 

42.839 

43.720- 

44.118 

44.943 

45.689— 

46.601 

47.672 

48. 671- - 

49.860 
51.128 
52.326- 
53.625 
55.201 
56.712 
57.938 

59.861 


60.845 
63.063 
64.871 
65.191 
65.680 
68.186 
67.815- 
70 . 114 


Walttr  Rccd  Amy  Institut*  of  Rostarch 
Dtpartntnt  of  Hicrowavo  Rtsoorch 
Woltcr  Rood  Arny  Hcdieol  Contor-  : 

Washington,  DC  20012 


SUBARRAY  MERXFICATION 

MUTUAL  COUPLING  ELEMENTS  6  TO  7 


Measurenent 

Date  t 

12:32 

PH 

FRI. , 

5 

OCT.  , 

1784 

4 

Calibration 

Date  t 

11:34 

AH 

FRI. , 

5 

OCT. , 

1784 

Froqutncy 
<MHj) - 


2000.000  — 
20S0.000 
2100.000 
2150.000^- 
2200.000 
22S0. 000 
2300.000^ 
23S0.000 
2400.000 
2450.000^- 
^SOO.OOO 
2S50.000 
2600.000^ 
2650.000 
2700.000 
2750.000- 
2800.000 
2850.000 
2700.000- 
2750.000 
3000.000 
3050.000- 
3100.000 
3150.000 
3200.000- 
3250.000 
3300.000 
3350.000- 


Magnitude 

-  .0043^ 
.0048 
.0047 

-  .0056 - 

.0057 

.0065 

.0066- 

.0067 

.0071 

.0075— 

.0077 

.0078 

.0082 

.0077 

.0077 

-  .0078— 
.0073 
.0  072 
.0065— 
.0063 
.0057 

-  .0053 
.0048 
.0042 
.0038— 
.0033 
.0028 

. 002S — 


Phase 

-27.1— 

112.3 
-107.6 

-  28^7— 

167.5 
-57.1 

83. 3 — 
-144.8 

.7 

131.7— 

-87.5 

46.2 

177.4- 

-40.7 

75.5 
-131.2- 

7.4 

142.6 
-88.3— 

51.5 
-173.1 

-33.8- 

101.4 
-124.1 

21.3- 
157.3 
-63.8 

76.7 


Insertion 
-Less-  <dB> 


47.281 - 

46.373 

46.257 

45.057 - 

44.513 
43.746 
43.631 — 
43.430 
42.724 

42 . 538 - 

42.085 
42.177 
41.746-  - 
42.004 
42.003 

42.114 - 

42.677 

42.817 

43.768 

43.772 

44.808 

45.535- 

46.378 

47.563 

48.397-- 

47.754 

50.761 

51.764  - 


3400.000 

.0022 

-146.5 

53.341 

3450.000 

.  0018 

-7.9 

54.977 

3500.000 

.0015 

130.7 

56.669 

3550.000 

.0012 

-89.3 

58.132 

3600 .000 

.  0011 

59.5 

59.408 

3650.000 

.  0008 

-158.1 

61.442 

3700.000 

.0007 

-10.9 

63.230 

3750.000 

.  0006 

139,5 

64.685 

3800.000 — 

- .0005— 

- 78-.  5 - 

-  65.477- 

3850.000 

.0004 

64.9 

66.976 

3700.000 

.0004 

-143.8 

69.096 

3750.000- 

.0004^ 

-  fr.  2 - 

-  68.025 - 

3777.777 

.0003 

163.9 

70.861 

.  Improvements  in  Data  Acquisition  Speed 
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An  8542C  Automatic  Network  Analyzer  is  used  to  measure 
transmission  loss  between  two  antenna  in  a  water  loaded  microwave 
scanner.  Because  of  the  number  of  measurements  required^  the 
time  to  collect  data  for  a  single  experiment  was  approximately 
four  hours.  The  objective  of  our  investigation  was  to  reduce  the 
data  collection  time  as  much  as  possible  without  redesigning  or 
replacing  the  existing  hardware. 

The  software  that  controls  the  movement  of  the  scanner  was 
the  first  candidate  for  improvement.  The  software  already 
provided  for  acceleration  up  to  maximum  speed.  It  computed  the 
point  to  start  the  deceleration  ramp  and  provided  for 

deceleration  such  that  there  was  very  little  chance  of 
overshooting  the  desired  position.  Hence,  the  only  change  to  be 
made  here  was  to  relax  the  positional  accuracy  for  each  axis  of 
motion.  The  digital  readout  for  this  system  has  a  resolution  of 
1  micron.  The  software  was  written  to  position  each  axis  to 
within  +1  micron  of  the  requested  location.  In  the  vicinity  of 
the  final  position,  the  motor  is  operated  in  the  single  step  mode 
which  is  it's  slow  speed  mode.  Consequently,  if  one  micron  of 
overshoot  occurs  the  direction  of  travel  will  be  reversed 
Reversal  of  direction  requires  that  the  backlash  in  the  gears  and 
lead  screw  be  taken  up  before  translation  can  occur  on  that 
axis.  During  this  time,  the  motor  is  operating  at  its  slowest 
speed  since  the  position  must  be  read  after  each  step.  To 
eliminate  much  of  this  slow  speed  operation,  we  reduce  the 
azimuth  accuracy  to  +10  microns.  This  resulted  in  approximately 
a  five  percent  increase  in  data  acquisition  speed  for  step  sizes 
of  2  millimeters  or  less  with  proportionally  less  improvement  as 
the  step  size  increased. 

Next,  the  time  required  for  the  network  analyzer  to  make  a 
measurement  was  determined.  For  step  sizes  of  two  millimeters  or 
less,  fifty  percent  of  the  acquisition  time  was  associated  with 
the  network  analyzer  measurement.  The  program  which  controls  the 
8542  during  the  measurement  is  named  CORS4.  Analysis  of  program 
CORS4  yielded  the  following  results. 

At  each  frequency,  this  program  switched  an  electro¬ 
mechanical  relay  in  the  input  test  unit.  A  time 
delay  in  the  software  was  necessary  to  allow  for  the 
switching  time.  Recruiting  the  software  to  eliminate 
the  need  for  switching  the  relay  will  increase  program 
speed. 


•>1  «-* 


When  the  frequency  is  initially  set,  the  program 
assumes  that  a  band  change  is  required.  With  each 
band  change,  the  software  provides  a  settling  time 
delay. 

The  CORS4  program  measures  both  transmission  (S21) 
and  refelction  (Sll).  For  this  application,  only 
the  transmission  measurement  was  required  so  elimina¬ 
tion  of  the  reflection  measurement  would  speed  up 
the  data  acquisition  process. 

CORS4  made  the  measurements  as  x  and  y  components  and 
then  converted  to  amplitude  and  phase.  However,  it  was 
necessary  to  convert  back  to  x  and  y  component  to  make 
further  corrections. 

C0RS4  returned  the  results  with  the  calibration  correc¬ 
tion  done.  If  the  measurement  was  to  be  made  at  a 
frequency  not  in  the  calibration  list,  we  could  not 
tell  if  the  calibration  data  was  close  enough  to  give 
a  usuable  result. 


After  reviewing  the  C0RS4  software  and  the  mathematical 
model  for  the  error  correction  algorithm,  we  came  to  the 
conculsion  that  we  could  use  the  same  subroutine  and 
approximations  as  C0RS4  used,  but  C0RS4  itself  needed  to  be 
rewritten  as  two  routines  and  simplified. 

One  of  these  routines  makes  a  measurement  of  the 
transmission  and  reflection  coefficient  at  a  specified 
frequency.  This  routine  makes  corrections  for  DC  offset  and 
attenuation  scaling  but  the  calibrations  are  left  for  the  other 
routine.  This  subroutine  is  able  to  speed  up  the  measurement  by 
a  factor  of  two  by  eliminating  a  pause  between  the  transmission 
and  reflection  measurement  which  is  not  necessary  since  each  call 
to  this  subroutine  only  measures  at  one  frequency. 


Rt 
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The  second  subroutine  makes  calibration  corrections  to  these 
measurement  using  a  specified  set  of  calibration  data.  We 
assumed  the  model  shown  on  page  3-41  of  the  8540  SERIES  SOFTWARE 
PROGRAMMER'S  MANUAL  is  valid.  Using  the  mathematical  model,  the 
effect  of  modifying  the  measurement  algorithm  can  be  predicted. 
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-o - < — o- 
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e32  I 
I — > — o- 


-o  M3 


Ie22 


I  UNKNOWN 
I  PORT 


■TRANSMISSION 

■return  arm 


The  measured  reflection  is: 


MO  =  e00+{e01*sll+e22*Q)/d 


The  measured  gain  is: 

M3  =  e30+(e32*s21)/d 

where;  Q  =  s21*sl2-sll*s22 

d  =  l-ell*sll-e22*s22-ell*s22*Q 

These  evaluations  were  solved  for  the  parameters  Sll  and 
S21.  Using  the  assuptions  defined  in  the  manual,  the  equations 
were  further  simplified. 


Subtract  leakage  and  define  new  terms: 

Til  =  MO-eOO 
T21  =  M3-e30 

Divied  by  tracking  gives; 

Tll/eOl  =  (M0-e00)/e01 
T21/e32  =  (M3-e30)/e32 


•  r  .  -  . 


Correcting  for  mismatch  gives: 

Sll  =  (Tll/e01)/(l+ell*Tll/e01) 

S21  =  (T21/e01)/(l+ell*Tll/e01) 

We  overcame  each  of  the  5  above  mentioned  objections  with 
the  following  results. 


1.  The  time  to  get  a  corrected  measurement  was  shortened 
by  more  than  fifty  percent, 

2.  The  new  routines  take  data  at  whatever  frequency  desired. 

3.  The  time  could  be  shortened  by  another  0.5  seconds  by  not 
measuring  the  reflected  wave  when  only  S21  is  needed. 
However#  due  to  the  need  for  the  reflection  measurement 
to  make  the  correction#  this  led  to  a  difference  of  from 
0.2  to  0.3  db  in  the  corrected  measurement. 

To  find  the  value  of  Sll  we  can  eliminate  the  transmission 
measurement  without  sacrificing  any  accuracy. 

4.  The  new  routines  returned  the  data  as  x  and  y  components 
which  makes  it  straight  forward  to  make  further  corrections 

5.  Since  the  calibration  correction  is  done  separately#  the 
user  can  vary  the  calibration  data  used  to  see  what  the 
change  in  the  corrected  reading  is.  Thus  he  can  tell  if 
he  needs  more  calibration  data. 


We  checked  the  results  of  the  original  CORS4  program 
measurements  against  the  new  routine  and  found  no  measureable 
difference. 


SECTION  III 


DATA  COLLECTION  SOFTWARE 
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^UR7  T«00004  IS  ON  CKOOOiO  USING  00036  BLXS  R=0228 


0001 
0002 
0003 
0004 
OOOS 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0  025 
0026 
0027 
0028 
0  029 
^613V 
^6139 
^6139 
S613V 
^613U 
S613V 
^6139 
^6139 
^6139 
^6139 
^4139 
^4139 
^4139 
^4139 
%4139 
^4139 
^4139 
^4139 
<4139 
^4139 
^4139 
%4139 
^4139 
^4139 
<4139 
^4139 
^4139 
^4139 
^4139 
'i4139 
^4139 

^4139 

c  ».  I 


FTN4.L 

C 


C 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0  052 

0053 

0054 

0055 

0056 

0057 

0058 

0059  C- 

0060  C 

0061  C- 

n  n  A9 


PROGRAM}  WR7 

FOR:  Walter  Reed  Arny  Institute  of  Research 
Departnent  of  Microwave  Research 
Waiter  Reed  Arrty  Medical  Center 
Washington,  DC  20112 

BY;  Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Moryland  20744  i 

Phone:  (301)  292-2592 


[  Progran  WR7  is  o  user  interactive  progran  for  control  t 
I  of  four  stepper  notors,  in  which  elevation,  zenith,  * 

I  rotation  and  azinuth  novenents  are  executed  to  position  * 

t  the  R.F.  antenna.  Coordinates  of  each  of  these  four  * 

possible  directions  are  olways  displayed  and  new  B 

coordinates  are  entered  for  position  change.  B 

B 

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB 

OGRAM  UR7 

this  line  contains  unprinted  escope  Y  to  turn  on  display  functons  Si 
INTEGER  CRT, OPTION, PRGNH,PRGNLSi 
REAL  INCRE<4)Si 

DIMENSION  IBUF<10,2),PRESNT<4> ,PNEW<4) ,IER<4) ,DlRECT(4),PRCNM<3)Si 

CRT=»1  V 

LUZE-29  Si 

LUAZ=31  Si 

LUEL-35  Si 

LUR0»33  Si 

MESS*0Si 

I1>1S446B  Si 

INCRE<1)«75.0  Si 

INCRE<2)*2.0Si 

INCRE<3)»20.0  Si 

INCRE<4)>20.0  Si 

IBUF<1,1)  ■  2HAZSi 

IBUF<2,i)  >  2HZESi 

IBUF<3,1)  -  2HELSi 

IBUF(4,1)  -  2HR0St 

IBUF<1,2)  »  2H  7Si 

IBUF<2,2)  a  2H  9S( 

IBUF<3,2)  ■  EHllSi 
IBUF(4,2)  a  2H13Si 
PKGNM(i)  a  iHWSi 


PRGNM<2)  a  IHRS, 
PRGNM<3)  a  1H7S, 
PRGNL  a  3  Si 
DO  50  Ial,4  Si 
PNEW<I)=9Ei3S, 

50  PRLSNT<I)*9E13S» 


I 


3* 

•h 

•I* 

I*' 


I 

I 


It 


Deternine  the  position  of  each  scanner  axis. 


('All  IJOl^rOT  1  mat  POl.-f;NT}4^  fCOO  MFQQ^C 


I 


wwwta  writer  w»%A»w**»>^wi»«»>»**^*^**»*^'>***’'**/****^'^*H 

^&13V  0  063  IF(  I£RR  .EQ.O)  GOTO  65  (, 

(613V  0064  CALL  UR12<CRT,IERR, .TRUE. ,IERR,IERR,PRCNM,PRCNL>( 

(613U  0065  GOTO  9000  ( 

(613V  0066  65  CALL  URi (CRT,LUZE,PRESNT(2> >IERR,MESS)( 

(613V  0067  JF<IERR.EQ.O)  GOTO  70  ( 

(613V  0068  CALL  UR12<CRT, lERR , . TRUE . , lERR , lERR .PRGNM, PRCNL)( 

(613V  0069  GOTO  9000  ( 

(613V  0070  70  CALL  UR  1 (CRT ,LUEL ,PRESNT(3) , lERR ,HE8S)V 

(61JV  0071  IF(IERR.EQ.O)  GOTO  80  ( 

(613V  0072  CALL  UR12(CRT, lERR , . TRUE . , lERR > lERR .PRCNM ,PRCNL)( 

(613V  0073  GOTO  9000  ( 

(613V  0074  80  CALL  UR3<CRT ,LURO ,PRESNT(4 > , lERR ,HE8S)( 

(613V  0075  IFdERR.EQ.O)  GOTO  90  ( 

(613V  0076  CALL  WH12(CRT, lERR, . TRUE . , lERR , lERR ,PRGNH ,PRCNL)( 

(613V  0077  C  GO  TO  9000( 

(613V  0078  - - 

(613V  0079  C  Display  htadings  on  CRT.  ( 

(613V  0080  - - 

(613V  0081  90  lHOHE«i5510B( 

(613V  0082  ICLEAR-15512B  ( 

(613V  0083  WRITE<CRT,100)  IHOKC»ICLEAR  ( 

(613V  0084  100  F0RHAT<2A2)  ( 

(613V  0085  URITE(CRT,105)( 

(613V  0086  105  FORMAT <21X, "WALTER  REED  ARMY  INSTITUTE  OF  RESEARCH" ,/ ,( 

(613V  0087  «26X, "SCANNER  POSITIONING  PROGRAM", />( 

(613V  0088  «/,( 

(613V  0089  *iX, "AXIS", 16X, "PRESENT  POSITION" , t6X , "NEW  POSITION" ,/,( 

(613V  0090  *1X," - ",16X," - ",16X," - 

(613V  0091  UMITE(CRT,120)( 

(613V  0092  120  FORMAT< "(6dBAZ(6deinuth " ,/ , /,  ( 

(613V  0093  *"(6dBZE(6dRnith",/,/,  ( 

(613V  0094  «"(6dBEL(6dt«vation",/,( 

(613V  0095  */,( 

(613V  0096  *"(6dBR0(6d9tati#n", /,/,/,  ( 

(613V  0097  */,( 

(613V  0098  «*(6dBG0(6d9",/,  ( 

(613V  0099  «"(6dBDE(6d9no",/,  ( 

(613V  0100  «"(6dBST(6deop",/,  ( 

(613V  0101  */,V 

(613V  0102  i"Entcr  your  selection.  _*)  ( 

(613V  0103  CALL  UPOAKPRESNT,  IBUF,  lER  >  ( 

(613V  0104  DO  122  I»l,4( 

(613V  0105  122  1ER(1)>0( 


(613V  0106  C - ( 

(613V  0107  C  Clear  selection,  reposition  cursor  for  a  new  one,  and  read  it( 

(613V  0108  C - - - ( 


(613V  0109  123  WR1TC(CRT,124)  I1,I1( 

(613V  0110  124  F0RMAT<lA2,-a  23c  21Y_  •,lA2,"a  23c  21Y_">  ( 

(613V  0111  125  READ(CRT,130)  OPTION^ 

(613V  0112  130  F0RMAT<1A2)  ( 

(613V  0113  IF  (OPTION  .NE.  2HAZ  .AND.  OPTION  .NE.  2HZE  .AND.  ( 

(613V  0114  «  OPTION  .NE.  2HEL  .AND.  OPTION  .NE.  2HRO)  CO  TO  S00( 


(613V  Oils  C - - - ( 

(613V  0116  C  Inquire  the  new  position. ( 

(613V  0117  C - ( 

(613V  0118  DO  200  1=1, 4V 


(613V  0119  IF  (OPTION  .NE.  IBUF(I,1>>  CO  TO  200( 

(613V  0120  WRITE(CRT,170)  I1,IBUF(I,2>  ( 

(613V  0121  170  F0RMAT(lA2,"a  S3c  ",1A2,"Y_">  ( 

(613V  0122  READ(CRT,*)  PNEW(I)  ( 

(613V  0123  GO  TO  250  ( 

(613V  0124  200  CONTINUER 

(613V  0125  250  GO  TO  123  ( 

(613V  0126  C -  „ 

(613V  0127  C  If  GO  xs  selected,  then  nove.( 

(613V  0128  C - 6 
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^41 3V 
^&13V 
%&13V 
'^&13V 
S&13V 
%&13V 
■^&13\; 
I  ^&13V 
%&13V 
%&13V 
^&13V 
'^<il3V 
^<il3V 
^&13V 
S413V 
^&13V 
^&13V; 
^&13V 
^&13V 
^&13V 
^«il3U 
^«il3\; 
S413V 
^M3y 
^&13V 
<(&13V 
^&13V> 
^413V 

^413V 
^4 13V 
^41 3V 
■t413V 
^413V 
^413V 
I  ^413V 
'(413V 
^413V 
I  •(413V 
^413V 
I  ^413V 
(413V 
(413V 
(413V 
(413V 
'  (413V 

;  ^413V 

(413V 
(413V 
(413V 
(413V 
(413V 
(413V 
(413V 
(413V 
(413V 
.  (413V 

(413V 
(413V 
(41 3  V 
I  (413V 
(413V 
(413V 
(413V 
C/L17U 


0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 
0179 
0180 
0181 
0182 
0183 
0184 
0185 
0186 
0187 
0188 
0139 
0190 
0191 
0192 
0193 
ni  V4 


500  IF  (OPTION  .NE.  2HG0>  CO  TO  1000(t 
IF(PNEU(1) .E0.9E13)  GOTO  600% 

CALL  UR6(PNEU(1)>IER<1),2,0)(| 

IF  ((lER(i)  .EQ.  0)  .OR.fi 
«  ((lER(l)  .EQ.  210B)  .OR.  (IER<i)  .EQ 
CALL  UR12(CRT,IER(1), .TRUE. ,IERR,IERR 
GO  TO  9000(| 

510  CALL  UR1(CRT»LUAZ,PRESNT(1> ,IERR, .TRUE. 

600  IF(PNEU<2)  .EQ.9E13)  GOTO  620(| 

CALL  UR6(PNEU<2>,IER(2)>l,0)(i 
IF  (<ICR(2)  .EQ.  0>  .OR.(i 
«  (<IER<2)  .EQ.  HOB)  .OR.  (I£R(2>  .EQ 

CALL  UR12<CRT>IER(2), .TRUE. ,IERR,1ERR 
GO  TO  9000(t 

610  CALL  UR1(CRT,LUZE,PRESNT(2) ,IERR, .TRUE. 

620  IF(PNEU(3) .EQ.9E13>  GOTO  640% 

CALL  UR6<PNEU<3)»IER(3),4,0>(| 

IF  <<IER(3>  .EQ.O)  .OR.  (t 
«  <<IER(3)  .EQ.  410B>  .OR.  (IER(3)  .EQ 

CALL  UR12(CRT,I£R(3)» .TRUE. ,IERR»IERR 
GO  TO  9000(| 

630  CALL  UR1<CRT,LUEL,PRESNT(3>»IERR, .TRUE. 

640  IF(PNEU<4)  .EQ.9Ei3)  GOTO  660(| 

CALL  UK6<PNEW(4),IER(4>,3,0)(| 

IF  (<IER(4)  .EQ.O)  .OR.  ^ 

«  (<IER<4)  .EQ.  310B>  .OR.  (IER(4>  .EQ 

CALL  WR12(CRT>IER(4), .TRUE. .lERR^IERR 
GO  TO  9000(( 

650  CALL  UR3(CRT,LURO,PRESNT(4),IERR, .TRUE. 


.  220B)>)  CO  TO  510(| 
,PRGNH,PRCNL)(i 


.  120B>))  CO  TO  6i0(i 
,PRGNH,PRCNL>(| 


.  420B)))  CO  TO  630(| 
,PRCNN,PRCNL)(| 


.  320B)))  GO  TO  650(t 
,PRCNH,PRGNL)(| 


C  Call  UPDAT  to  display  th«  currant  location*  and  tros*  th*  ntwV 
C  position  colunn.  (i 

C - 

660  CALL  UPOAT(PR£SNT,lBUF,ICR> 

DO  670  I>l,4(t 
PNEUd)  «  9Ei39 
670  lERd)  =>  0(, 

GO  TO  123  (, 

1000  IF  (OPTION  .NE.  2HDE>  CO  TO  2000(| 

C - 

C  DEMO  section. V 

C - 

DO  1050  1-1,4  (| 

1050  D1RECT(I)-1.0  ^ 

DO  1800  I-l,10(, 

01055  CALL  UR1(1,LUAZ,PRE3NT(1>,IERR,.TRUE.>(| 

CALL  UR1(1,LUZE,PRESNT(2>,ICRR, .TRUE. >( 

CALL  URKl  ,LUEL,PRESNT(3>  ,IERR,  .TRUE.  )St 
CALL  UR3(l,LURO,PRESNT(4>,lERR, .TRUE. >( 

DO  1200  J-1,4  (t 

PNEU(J)  -  PRESNT(J)  4-  INCRE( J)*DIRECT( J>(t 

WRITE(CRT,1100)  II , IBUF( J ,2) ,PRESNT ( J ) , II , IBUF( J , 2) ,PNEM( J )  (i 
1100  F0RMAT(lA2,"a  22c  “ , 1A2, 'Y • ,F12 . 4 , 1A2, "a  53c  • , 1A2, "Y" ,F12 . 4)  ^ 
1200  CONTINUER 


C  Move  the  Azinuth  axis.  V 

C - 

CALL  UR6(PNEM(1),XERR,2,0)( 

IK  (lEKR  .EQ.  0)  CO  TO  1300  ( 

IF  (dERR  .NE.  210B)  .AND.  (lERR  .NE.  220B))  GO  TO  1290  ( 
DIRECT(l)  »  -(D1RECT(1))( 

GO  TO  1300V 

1290  CALL  UR12(CRT,ItRR, .TRUE. ,1ERR,IERR,PRGNM,PRCNL)V 
GO  TO  9000V 


r  hnu#  th*  7.Bnith  n  y  i  «  . 


I 

« 

k 

s 


^«.13V  0195 
0196 
^M3V  0197 
•^613V  019B 
%413V  0199 
%613V  0200 
^613V  0201 
^613U  0202 
S&13<;  0203 
^613V  0204 
^613V  0205 
^613V  0206 
%613V  0207 
%613V  0208 
S613V  0209 
^613V  0210 
^&13V  0211 
^613V  0212 
^613V  0213 
1613V  0214 
^613V  0215 
1613V  0216 
(613V  0217 
(613V  0218 
(613V  0219 
(613V  0220 
(613V  0221 
(613V  0222 
(613V  0223 
(613V  0224 
(613V  0225 
(613V  0226 
(613V  0227 
(613V  0228 
(613V  0229 
(613V  0230 
(613V  0231 
(613V  0232 
(613V  0233 
(613V  0234 
(613V  0235 
(613V  0236 
(613V  0237 


C - 

1300  CALL  UR6(PNeU(2),IERft,l,l>( 

IK  <IERR  .EO.  0)  CO  TO  1400  ( 

IF  ((lERR  .NE.  1108)  .AND.  (lERR  .NE.  1208))  CO  TO  1390  ( 
DIRECT(2)  -  -<DXRECT(2))( 

CO  TO  1400( 

1390  CALL  UK12<CRT,IERR, .TRUE. ,IERR,IERR,PRCNM,PRCNL)V 
CO  TO  9000( 

C - 

C  Nov*  tha  Elawatlon  oxia.  ( 

C - 

1400  CALL  UR6(PNEU<3)>IERR,4,i)( 

IF  (lERR  .EQ.  0)  CO  TO  1500  ( 

IF  ((lERR  .NE.  4108)  .AND.  (lERR  .NE.  4208))  GO  TO  1490  ( 
DIRECT(3)  ■  -<DIRECT(3))( 

GO  TO  1500( 

1490  CALL  UK12(CRT,IERR, .TRUE. ,IERR,IERR,PRCNH,PRCNL)( 

CO  TO  9000( 

C - 

C  Nova  tha  rotation  axis.( 

C - 

1500  CALL  UR6(PNEU(4),IERR,3,1)( 

IF  (lERR  .EQ.  0)  GO  TO  1800  ( 

IF  <(IERR  .NE.  3108)  .AND.  (lERR  .NE.  3208))  CO  TO  1590  ( 
DIRECT<4)  «  -<DIRECT<4))( 

GO  TO  1800( 

1590  CALL  WN12(CRT,IERR,  .TRUE.  ,IERR,I£RR,PRCNN,PRCNL)(| 

GO  TO  9000( 

1800  CONTINUES) 

CO  TO  123  ( 

C - 

C  Sea  if  tha  user  wishes  to  stop  tha  progran.( 

C - 

2000  IF  (OPTION  ,EQ.  2HST)  CO  TO  9000( 

CO  TO  123  ( 

C - 

C  Tarninota  tha  progran.  ( 

C - 

9000  END  ( 

C - 

c - 

C - 

C  Subroutine  UPDAT  will  display  tha  currant  locations  and  arasa  nawS) 


(613V 

(613V 

(613V 

(613V 


0238 

0239 

0240 

0241 


C 

C- 


position  colunns.Si 


(613V 

(613V 

(613V 

(613V 

(613V 

(613V 

(613V 

(613V 


0250 

0251 

0252 

0253 

0254 

02S5 

0256 

0257 


SUBROUTINE  UPDAT(PRE8NT, IBUF,IER )  ( 
DIHENSION  PRESNT(4),IER(4) ,I8UF(10,2) 


(613V 

0242 

11-154468  f. 

(613V 

0243 

DO  100  I-l, 

RSi 

(613V 

0244 

WRITE<1,20) 

I1,IBUF(I,2),PRESNT<I)S, 

(613V 

0245 

20  F0RNAT(1A2, 

•a  22c 

-,1A2 

,*Y",F12.3,30( 

"  ") 

>Si 

(613V 

0246 

IF  (<IER(I) 

.NE. 

1108) 

.AND.  (IER(I> 

.NE. 

1208) 

.AND. 

Si 

(613V 

0247 

«  <1ER<I) 

.NE. 

2108) 

.AND.  (XER(I) 

.NE. 

2208) 

.AND. 

Si 

(613V 

0248 

*  (lER(I) 

.NE. 

3108) 

.AND.  (lER(l) 

.NE. 

3208) 

.AND. 

Si 

(613V 

0249 

»  <IER<I) 

.NE. 

4108) 

.AND.  (lER(l) 

.NE. 

4208)) 

GO  TO 

1  50 

30 

50 

60 

100 

C  (Z 


WRITE(1,30)  Ilf, 
F0RMAT<lA2,'a  22C 
GO  TO  100  ft 
URITE(1,60)  Ilf, 
F0RMAT<lA2,'a  22C' 
CONTINUES, 

RETURNS, 


Linit  Exccadad'')f, 


,30(*  *))  fi 


( 


Si 

Si 

I 

Si 

Si 
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OOOi 

0002 

0003 

0004 

OOOS 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

OOlS 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

002S 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

003S 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

004S 

0046 

0047 

0048 

0049 

0050 

0051 

0052 


FrN4,L 

C  24998-18466  R6U.2040  <810304.1057) 

C************************************************************************* 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PROCRAH  UN8 


DESCRIPTION: 

UR8  is  dcsigntd  to  obtain  nicrowov*  transnission  data  at  difftrcnt 
points  along  a  scon  of  ony  objact  ond  than  to  nak«  a  graph  of 
atttnuotion  versus  position  of  those  dota. 

This  progran  has  been  divided  into  three  segnents  becouse  it 
connot  fit  into  nenory  otherwise.  The  Main  segnent  alwoys  rcMoins 
in  MOMory.  The  other  two  segnents  overlay  each  other  by  one 
segnent  colling  EXEC(8,  other  segnent  none)  to  rood  in  the 
ether  segnent  over  the  calling  segnent  and  then  pass  control 
to  it.  It  con  return  to  the  colling  segnent  only  by  calling 
EXEC<8,  other  segnent  none)  ogoin. 

This  segnent  is  the  noin  segnent.  It  is  run  by  typing  in; 

RU,UR8 

This  segnent  only  defines  connon>  initiolizes  voriables,  and 
then  calls  EXEC<a>WR8C)  to  rood  in  ond  pass  control  to  segnent 
URSC. 


c 

PROGRAN  UR8 


DINENSION  DAT<1002»2),IPRNN<3>>INANE<3) 

INTEGER  CRT 

COMMON  DAT, IPRNM, INANE, CRT, IPRNL,MESS>ICODE,PRESNT, 
*  OFFSET , STEPSZ ,RFR£Q , lEND , TEMP 1 , TEMP2 , IRNUN 

IRNUM  «  1 


CRT  =  1 
IPRNM<i) 
IPRNM(2) 
IPRNM(3) 
IPRNL  «  3 
MESS  ■  -1 
OFFSET  -  10 
STEPSZ  •  10 
lEND  »  3 


IHW 

IHR 

1H8 


C- 

C 

c- 

c 


Call  EXEC  to  read  in  segnent  WR8C  and  poss  control  to  it. 


ICODE-8 

INAME<1)*2HUR 

INAME<2)-2H8C 

INAME<3}>2H 

CALL  EXEC  (ICODE,  INANE) 

END 

END* 
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OOOi 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0  047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 


F  rM4 , 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


«»«»««««««»««««»«««»««««»««»»»««*««»»««»*«»»««»**««««««««««* 

SE.GMLNT :  UR8C 

♦  ♦♦♦♦♦♦♦♦♦♦♦•»-+++++++++++*  +  +  ++4'  +++++++*+ 

FOR  I  Ualtcr  Re«(t  Arny  Institutt  of  Research 
Departnent  of  Microwave  Research 
Walter  Reed  Arny  Medical  Center 
Washington,  DC  20112 

♦♦♦♦♦♦♦♦♦♦+♦♦■*■♦♦+♦+♦♦+++♦♦■♦■++♦++♦♦♦+♦♦ 

BY:  Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Pho.net  (301)  292-2592 


*  Segnent  WR8C  is  the  control  segnent  of  WR8.  It  puts  * 

*  out  a  nenu  with  the  options:  * 

«  1  -  Enter  the  offset  and  step  size.  * 

*  2  -  Enter  the  nicrowave  frequency.  * 

*  3  -  Set  antennae  to  a  new  position.  * 

*  4  -  Enter  nunber  of  readings  to  average  for  each  point.  • 

*  5  -  Scan  fron  present  position  * 

*  9  -  Terninate  the  proqra«.  * 

*  After  5  is  chosen,  the  antennae  are  psitioned  at  the  * 

»  present  position-offset  and  advanced  by  stepsize  until  * 

*  the  the  antennae  reoch  present  position+offset .  At  each  * 

*  position,  amplitude  is  averaged  over  the  nunber  of  * 

*  readings  specified  in  4  and  saved  in  the  array  DAT  olong  t 

*  with  the  position.  At  the  end  of  the  scan,  this  segnent  « 

*  calls  EXEC  to  reod  in  segnent  UKBG  and  pass  control  to  it.« 

«  * 

PROGRAM  UR8C,5 

DIMENSION  DAT<1002,2) ,IPRNM<3> ,INAME(3) 

INTEGER  CRT 

COMMON  DAT , IPRNM , INANE , CRT , IPRNL ,MESS , ICODE , PRESNT , 

*  OFFSET, STEPSZ,RFREQ,IEND, TEMPI ,TENP2,IRNUM 

C0MM0N/AGS2C/  D< 10 ) ,CAL( 6, 1 12) , FI , F2 ,F3 , Ml ,M2 ,RPi ,RP2,RP3,N0NLy, 
*CM<4,112),IHEAD<40),IDATE(15) 

CALL  FILE2(1) 

TEMPI  =  D(l) 

TENP2  »  (D(3)-l)  *  D<2)  ♦  D(l) 

LUAZ  a  31 


C - 

C  Cl 
C - 


ear  screen  and  print  heading. 


WRITE<CRT,iS) 

FORMATC", 

«  i0X,55»*»,/, 

ClOX,  “e^ZOX,  "PROGRAM  WR8" ,  21X  , 

»10X,  "»",16X, "S2i  LINE  SCAN  PROGRAM  ", 16X , 
*10X,55'*' ' ' ) 


005? 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0067 

0068 

006? 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

007? 

0080 

0081 

0082 

0083 

0084 

0085 

0086 

0087 

0088 

008? 

0090 

00?1 

0092 

0093 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0101 

0102 

0103 

0104 

0105 

0106 

0107 

0108 

010? 

0110 


530  CALL  URl  (CRT , LUAZ ,PRESNT, ILRR , 0 ) 

IF  (lERR  .EO.  0)  GO  TO  535 

CALL  URi2  (CRT,  lERR,  .TRUE.,  0,  0,  IPRNH,  IPRNL) 

GO  TO  9090 

535  WRITE(CRT,540)  PRLSNT 

540  FORMAT  (/,  IX , “PRESENT  POSITION  ■“ ,F9 . 3 , “««“ ) 

550  UR1TE(CRT,600) 

600  FORMAT(/,‘  PLEASE  SELECT  AN  OPTIOHi“,/, 

*"  1  -  Ent«r  tht  offsat  and  step 

»“  2  -  Ent«r  th€  nicrowavc  fr«qo*ncy . " 

«“  3  -  S«t  anttnnac  to  a  new  position . 

«“  4  -  Enter  nunber  of  readings  to  average  for  each  point,*,/, 

*“  5  -  Scan  fron  the  present  postion.*,/, 

$"  9  -  Terninate  the  progran. “ 

*"  ENTER  SELECTION  _“) 

READ(CRT,«)  IANS 
IF  (IANS  .EQ,  9999)  GO  TO  9090 
IF  (IANS  .EO.  9)  GO  TO  9090 

IF  (IANS  .EQ.  5)  GO  TO  5000 

IF  (IANS  .EO.  4)  GO  TO  4000 

IF  (IANS  .EO.  3)  GO  TO  3000 

IF  (IANS  .EQ.  2)  GO  TO  2000 

IF  (IANS  .EQ.  1)  GO  TO  1000 

WRITE  (CRT, 620) 

620  FORMAT  (/, IX, “ERROR  ♦  WR8  -  10201  . (WR8>“,/, 

«  iX, "INCORRECT  RESPONSE.  ENTER  1,  2,  3,  4,  5,  OR  9.") 

GO  TO  550 

C - 

C  Inquire  from  the  user:  step  size  and  starting  offset. 

C - 

1000  URI''E(CRT,1100) 

1100  FORMAT(/,"  Enter  the  starting  offset  (««) .  _“) 

READ(CRT,»)  OFFSET 
IF  (OFFSET  .EQ.  9999)  GO  TO  9090 
IF  (OFFSET  .LT.  105)  GO  TO  1190 
WRITE  (CRT, 1109) 

1109  FORMAT  (/,iX, “ERROR  #  WR8  -  10202  . (WR8)“,/, 

*  IX, "THE  OFFSET  MUST  BE  LESS  THAN  10Sn«.“,/, 

«  IX, “REENTER  THE  STARTING  OFFSET.’) 

GO  TO  1000 

1190  WRITE(CRT,1200) 

1200  FORMAT(/,“  Enter  the  step  size  (nn) .  “) 

READ(CRT,*)  STEPSZ 
IF  (STEPSZ  .EQ.  9999)  GO  TO  9090 
lEND  -  (OFFSET»2.0)/STEPSZ  *1.5 
IF  (lEND  .LT.  1001)  GO  TO  530 
WRITE  (CRT, 1209) 

1209  FORMAT  (/, IX, “ERROR  ♦  WR8  -  10203  . (HR8)“,/,1X, 

«  "THE  NUMBER  OF  DATA  POINTS  MUST  NOT  EXCEED  1000.",/, 

*  IX, “REENTER  THE  STARTING  OFFSET  AND  STEP  SIZE.*) 

GO  TO  1000 

C - 

I  Inquire  the  Microwave  frequency. 


2000  WR1TE(CRT,2500) 

2500  FORMAK/,"  Enter  the  RF  frequency  (MHz)...  “) 

READ(CRT,«)  RFREQ 

IF  (RFREQ  ,EQ.  9999)  GO  TO  9090 

IF  ((RFREQ  .Gt.  TEMPI)  .AND.  (RFREQ  .LE.  TEMP2))  GO  TO  530 
WRITE  (CRT, 2509)  TEMPI,  TEMPZ 


X 


0119 

0120 

0121 

0122 

0123 

0124 

012S 

0126 

0127 

0128 

0129 

0130 

sm 

0134 

013S 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

Q14S 

0146 

0147 

0148 

0149 

OISO 

JlSl 

)1S2 

)1S3 

1154 

1155 

1156 

1157 

1158 

1159 

1160 
1161 
1162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 


19  FORHAT  (/,iX, “ERROR  ♦  WR8  -  10204  . (UR8)“,/,1X, 

*  “CALIBRATION  QNLIT  FROM  “,F6.0,*HHi  TO  “ , F6 . 0 ,  “MHz  .  ‘ 

*  /, IX, “FREQUENCY  MUST  BE  BETWEEN  CALIBRATION  LIMITS. 

»  /,1X,“D»  you  wish  to  recalibrate?  <YES/NO)  _“> 

READ  (CRT, 2599)  IANS 
)9  FORMAT  <A2) 

IF  (IANS  .EQ.  2HYE)  GO  TO  9000 
CO  TO  2000 

Inquire  new  position  and  call  UR6  to  set  it. 


3000  WRITE  (CRT, 3090) 

3090  position  (h«) 

if.  .EO.  9999)  GO  TO  9090 

<P5ESNT,IERR.2.0) 


IF  ( lERR  :eq:“0) 'go  Td  ^30 

GQ^’to^JoIo**^'’^'^^”*'  »®»®»*P'’NH,IPRNL) 


- - 

»♦“  '•«Qlinqs  per  dotrioln^ 

4000  WRITE  (CRT, 4009) 

4009  FORMAT  (/,1X, 

%EM  •'■•'■•■g.  p.r  dg.g  p.in,.  , 

4509  FORMAT  (/, IX, “ERROR  «  WK8  -  10205  . (WR8)*  / 

*  IX,  “NUMBER  TO  AVERAGE  MUST  BE  FROM  1  -'32767,“,/, 

GO  TO  4000 number  OF  READINGS  TO  AVERAGE  PER  POINT. 

- - 

PRESNT+OFFSETrput'sBrin'DATu’sr’ 

5000  IF  (RFREQ  .NE.  0)  GO  To'siOO 
RFREO  =  D(l) 

5100  P03ITN  a  PRESNT-OFFSET 
CALL  CALF2(3,  MC,  RFREQ) 

DAT (1,1)  =  PRESNT  -  OFFSET 

DAT (1,2)  ■  PRfcSNT  ♦  OFFSET 

DAT(2,1)  a  STEPSZ 

DAT(2,2)  a  RFREQ 

DO  5800  1*3, IEND+2 
IF  (IFBRK(IERR))  9090,5200 
5200  PARAM  »  POSITN 

CALL  UR6(PARAM,IERR,2,0) 

IF  (lERR  .EQ.O)  GO  TO  5700 

CALL  WR12(CRT,IERR, .TRUE. , 0 , 0 , IPRNM , IPRNL) 

GO  TO  9090 

C  CALL  CALF2(2,1,F) 

5700  XAVE  =  0. 

YAVE  »  0. 

DO  5750  J=1,IRNUM 

CALL  MESUR(RFREa,  XI,  Yl,  X,  Y) 

CALL  CORCKMC,  XI,  Yl,  X,  Y) 

XAVE  ■  XAVE  +  X 

5750  YAVE  =  YAVE  Y 

XAVE  *  XAVE  /  IRNUM 

YAVE  =  YAVE  /  IRNUM 


RLOiiS  =-10*ALn(;T(XAVE*XAVE  +  YAVEtYAVE) 


0180 

WRITE  (CRT, 5799)  POSITN,RLOSS 

0181 

5799 

FORMAT  (IX, “AZIMUTH  •  ",F8,3,*  RLOSS  -  ",F9.4) 

0182 

DAT(I,2)  -  RLOSS 

0183 

DAT(I,1)  -  POSITN 

0184 

POSITN  *  POSITN  ♦  STEPSZ 

0185 

5800 

CONTINUE 

U±U6 

CALL  WR6  (PRESNT,IERR,2,0) 

0188  C  Call  EXEC  to  ovcrlaw  thxs  with  WR8G 

0189  C - - - 

0190  INAME(2)  »  2H8C 

0191  CALL  EXEC  ( ICODE , INAHE) 

0192  9000  WRITE  <CRT,9009) 

0193  9009  FORMAT  (2/, IX, "Run  proQran  AGS02  for  now  calibration 

0194  9090  WRITE  (CRT, 9099) 

0195  9099  FORMAT  <3/,10X, 

0196  «"»«»«»««»««  PROGRAM  WR8  TERMINATED  »»«»«»«««$") 

0197  END 

0198  C 

0199  C  Block  data  routino  for  AGS2C 
0200  C 

0201  BLOCK  DATA  AGS2C 

0202  COMMON  /AGS2C/  1(2330) 

0203  END 

0204  END* 


6WRi:lG  T>00004  IS  ON  CR32767  USING  00088  BL.KS  R  =  0661 
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SI£GMENT:  UR8G 

FOR;  Walter  Reed  Arny  Institute  of  Research 

Department  of  Nicrowave  Research  < 

Walter  Reed  Army  Medical  Center 
Washington,  DC  20112 

++-f*+++++-«-++'f+++++++++++++++*t++++++++ 

BYi  Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744  > 

Phone i  <301)  292-2592 


C  M  Segment  WN8C  is  the  graphing  segment  of  WR8.  It  is  * 

C  «  read  in  and  control  passed  to  it  by  an  EXEC(8,WR8C)  call  * 

C  *  from  segment  WR8C  after  a  scan  is  finished.  WR8G  then  * 

C  t  displays  a  graph  of  the  attenuation  versus  position  * 

C  *  on  the  CRT.  This  graph  is  displayed  until  the  user  * 

C  «  presses  the  return  key  at  which  point  UR86  calls  EXEC  • 

C  t  <8,WK8C)  to  read  in  WR8C  and  pass  control  to  it,  unless  * 

C  *  the  user  enters  '9999*  first  in  which  case  WRB6  * 

C  *  terminates  the  program.  * 

C  «  <t 

PROGRAM  UR8G,5 
C 

DIMENSION  DAT<1002,2) ,1PRNM<3) ,INAME(3) 

INTEGER  STATUS,  ALPHLU,  GOUTLU,  CRT 

COMMON  DAT , IPRNM, INANE , CRT , IPRNL , MESS , ICODE , PRESNT , 

*  OFFSET , 3TEPSZ ,RFREO, lEND , TEMP  1 , TEMP2 , IRNUM 

DATA  ALPHLU,  GOUTLU  /!,!/ 

C 

C  STATUS  -  Set  to  zero  if  no  errors  occur  in  a  called  routine 

C  ALPHLU  -  The  LU  of  the  alphanumeric  device 

C  GOUTLU  -  The  LU  of  the  graphics  output  device 

C 

C 

XMIN  -  DAT(l,i) 

XMAX  »  DAT<1,2) 

YMIN  «  DAT(3,2) 

YMAX  »  DAT<3,2) 

DO  5100  I>4,ILN0-'^2 

IF  (DAT<I,2)  .GT.  YMAX)  YMAX  ■  DAT<I,2) 

IF  <DAT<I,2)  ,LT.  YMIN)  YMIN  “  DAT<I,2) 

5100  CONTINUE 
5110  CONTINUE 

C - 

C  Initialize  DGL  system 

C - 

URITe(CRT,S200) 

5200  FORMAT("“) 


.V.'*  .V 
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0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0066 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0  096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 


CALL  ZBECN 


C  Enable  all  devices,  exit  If  any  errors 


CALL  ENDEV  (ALPHLU,COUTLU, STATUS) 
IF  (STATUS  .NE.  0)  GOTO  9990 


C  Perforn  the  viewing  transf ornation ,  exit  if  any  errors 

C - - - 

IF  (ABS(YMIN)  .NE.  YHIN)  CO  TO  5300 
YHIN  ■  INT  (YMIM) 

CO  TO  5400 

5300  YMIN  ■  INT  (YHIN  -  .999) 

5400  IF  <AB3(YHAX)  .NE.  YHAX)  GO  TO  5500 
YHAX  ■  INT  (YHAX  ♦  .999) 

CO  TO  5600 

5500  YHAX  «  INT  (YHAX) 

5600  IF  ((YHAX-YHIN)  .LT.  6.)  YHAX  -  YHIN  ♦  6. 

CALL  VIEUT  ( STATUS, XH1N,XHAX, YHIN, YHAX) 

IF  (STATUS  .NE.  0)  GOTO  9990 


C  Draw  axis  and  label,  then  plot. 

C - 

CALL  ORUDT ( XHIN , XHAX , YHIN, YHAX , DAT , lEND ) 


C  Disable  logical  devices 

C - 

READ  (CRT,»)  IANS 

IF  (IANS  .EQ.  9999)  CO  TO  9990 

CALL  ZNEUF 

CALL  CLEAR 


C  Call  EXEC  to  overlay  this  segnent  with  URBC  and  execute  it. 

C - 

INANE (2)  >  2H8C 

CALL  EXEC  (ICODE,  INAHE) 

9990  CONTINUE 
C 

CALL  ZAEND 
CALL  ZDEND 


C  Disoble  OGL  systen 

C - 

CALL  ZEND 


C  Terninate  progran 

C - 

9998  WRITE(CRT,9999) 

9999  FORMATC") 

END 

C 

C************************************************************************* 

C  ENDEV;  SUBROUTINE 

C 

C  PURPOSE;  This  subroutine  enables  all  logical  devices  used  by 

C  The  progran. 


C  DESCRIPTION;  This  subroutine  enables  the  DGL  work  station.  The  DCL 
C  workstation  contains  alphanumeric  and  graphics  output 

C  devices. 


.V 
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C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CALLING  SEQUENCE)  CALL  END£V(ALPHLU,GOUTLU, STATUS) 

PARAMETERS: 

ALPHLUt  tINTEGER]}  Alphanun«ric  LU 

COUTLUt  [INTEGER};  Graphics  output  LU 

STATUS)  [INTEGER);  3#t  to  r«po  if  no  srrors  occur 

during  initialisation  of  tht 
workstation.  It  is  sat  to  ths 
D6L  error  return  value  if  an 
error  is  found. 


C******************t1f$***t*t*t$t*1li]tt9**t*********f*t****t*ttt*t**t****t*t 

C 


SUBROUTINE  ENDEU ( ALPHLU , COUTLU , STATUS ) 


c- 

INTEGER  ALPHLU,  COUTLU,  STATUS 
INTEGER  CONTRL 

c 

c 

If  an  error  occurs,  write  out  an  error 

nessoge,  and  return. 

c 

r- 

Enable  alphanuneric  device 

CALL  ZAINT  ( ALPHLU, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  1000 

CALL  ERRMS  (ALPHLU, STATUS, 6HZAINT 
1000  CONTINUE 

) 

C 

C- 

Enable  graphical  display  device  w/out  spooling;  e.g.  CONTRL  »  0. 

CQNTRL  «  0 

CALL  2DINT  <GOUTLU,CONTRL, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  9999 
CALL  ERRMS  (ALPHLU,STATUS>6HZDINT  ) 
9999  CONTINUE 


C  Return  to  nain  proqraM  after  all  devices  are  properly  enabled 


RETURN 

END 


C****t******t******t*M***Mt***tM9**********t**M99*9**9*9t****1l*******t**Mt 

w 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE: 


DESCRIPTION) 


SUBROUTINE  VIEWT 

This  subroutine  perforns  the  initial  viewing 
transf ornation . 

This  subroutine  perforns  the  viewing  transf ornation  in 
the  following  steps: 

-  Places  the  inage  on  the  largest  possible  area 

-  Sets  the  window  to  the  desired  range. 

-  Resets  the  viewport  to  leave  roon  for  labels 

-  Reconputes  character  size  based  on  specified  window 


CALLING  SEQUENCE)  CALL  VIEMT 
PARAMETERS:  NONE 
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0179 
0180  C 

0181  SUbROUTINE  VIEUTOTATUS  ,UXMIN,WXNAX  ,UYMIN,UYHAX ) 

0182  C 

0183  INTEGER  IDUN,  lERR 

0184  REAL  AR<2) ,WIEU<4) ,X3I2E,YSIZE,XCSIZ,YCBIZ 

0185  REAL  UXH1N,UXMAX,UYMIN,UYMAX,I1INX.MAXX,MINY,MAXY 

0186  C 

0187  C  IDUH  -  DuMny  var 

0188  C  lERR  -  Error  rtturn  (not  used) 

0189  C  AR  -  Holds  aspect  ratio 

0190  C  VIEW  -  Holds  current  viewport  bounds 

0191  C  XSIZE  -  Tenp  work  varioble 

0192  C  YSIZE  -  Tenp  work  variable 

0193  C  XCSIZ  -  Tenp  holder  of  character  size  X 

0194  C  XCSIZ  -  Tenp  holder  of  character  size  Y 

0195  C  WXHIN  -  Tenp  holder  of  window  X  -  nin 

0196  C  UXHAX  -  Tenp  holder  of  window  X  -  nas 

0197  C  UYHIN  -  Tenp  holder  of  window  Y  -  nin 

0198  C  UYMAX  -  Tenp  holder  of  window  Y  -  na« 

0199  C  MINX  -  Tenp  holder  of  new  viewport  X  -  nin 

0200  C  MAXX  -  Tenp  holder  of  new  viewport  X  -  naz 

0201  C  MINY  -  Tenp  holder  of  new  viewport  Y  -  nin 

0202  C  MAXY  -  Tenp  holder  of  new  viewport  Y  -  na* 

0203  C 

0205  C 

0206  C  Inquire  aspect  ratio  of  logical  disploy  Units 

0207  - - 

0208  CALL  ZIUS  (254,0 ,2, IDUH, AR, lERR) 

0209  IF  (lERR  .EQ.  0)  GO  TO  555 

0210  CALL  ERRHS  ( 1 , lERR ,6HZIUS  > 

0211  GO  TO  9999 

0212  - - 

0213  C  Make  the  largest  possible  area  of  the  logical  display  available 
0214  C  for  graphical  output  by  setting  the  aspect  ratio(AR>. 

0215  - - 

0216  555  YSIZE  «  AR(2) 

0217  XSIZE  -1.0 

0218  CALL  ZASPK  (XSIZE, YSIZE) 

0219  - - 

0220  C  Specify  the  desired  range  of  X  and  Y  values  of  the  window 

0221  - - 

0222  CALL  ZUIND  (UXMIN, UXHAX, UYHIN, WYMAX) 

0223  - - 

0224  C  Inquire  current  viewport  Units 

0225  - - 

0226  CALL  ZIUS  ( 451 , 0,4, IDUH, VIEU, lERR ) 

0227  IF  (lERR  .EQ.  0)  GO  TO  577 

022B  CALL  ERRMS  ( 1 , lERR ,6HZIU8  ) 

0229  GO  TO  9999 

0230  - - 

0231  C  Calculate  the  lower  left  hand  corner  of  the  viewport  and  leave 
0232  C  enough  roon  for  labels.  The  viewport  is  reduced  12X  on  each  side 
0233  C  to  give  roon  for  lables.  Set  the  new  viewport 

0234  - - 

0235  577  HINX  »  .12  *  UIEU(2) 

0236  MAXX  *  .88  *  V1EU(2) 

0237  MINY  «  .12  S  VIEU(4) 

0238  MAXY  «  .88  *  VIEW(4) 
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CALL  ZVIEU  (H1NX,HAXX,H1NY,MAXY) 


C  Now  s«T  th«  charactor  six*  bosod  on  th«  size  of  th«  window 
C  Tho  constants  bslow  product  a  rtadablt  ebaraettr  size  in  the  new 
C  window. 

C - 

XCSIZ  -  .015  «  <UXMAX  *  UXHIN) 

YCSIZ  >  .025  «  (UYHAX  -  UYHIN) 

CALL  ZCSIZ  <XC8IZ, YCSIZ) 

C 

9999  RETURN 
END 

C  SUBROUTINE  DRUDT 

C 

C  PURPOSE)  This  subroutine  draws  the  current  graph. 

C 

C  DESCRIPTION:  This  subroutine  clears  the  olphanuneric  and  graphics 
C  displays.  It  then  draws  the  current  graph.  Note 

C  that  if  the  user  has  not  changed  any  data  ualues 

C  the  default  ualues  will  be  used. 

C 

C  CALLING  SEQUENCE:  CALL  DMUOT 
C 

C  PARAHETERS)  NONE 

C 

c 

SUBROUTINE  DRMDT< XHIN , XMAX , YHIN , YHAX , DAT , lEND) 

REAL  DATt 1002,2) 

DIHENSION  ILIST(3) 

INTEGER  TEXT< 12), OPCODE, RSIZE 


REAL  VIEU<4) 
DATA  NARKNO/6/ 


C 

C  VIEW 


-  Tenp  holder  of  viewport  bounds 


c 

C  Clear  the  graphics  and  alphonuneric  displays 

C - 

CALL  ZNEUF 
CALL  CLEAR 

C - 

C  Deternine  paraneters  for  LAXES  coll.  Seorch  thru  data  for  YNAX. 

C - 

c - 

XTIC  «  <XMAX-XMIN)/10.0 

YTIC  -  <YMAX-YMIN)  /  10.0 

XORG  -  XNIN 

YORG  »  YMIN 

XMJC  =1.0 

YMJC  -1.0 

TSIZE  -  .02 

CALL  LAXES(XTIC, YTIC, XORG, YORG, XMJC, YMJC, TSIZE) 

C - 

C  Plot  the  graph. 

C - 

CALL  ZM0VE(DAT<3,1),DAT(3,2)) 
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0331 

0332 

0333 

0334 

0335 

0336 

0337 

0338 

0339 

0340 

0341 

0342 

0343 

0344 

0345 

0346 

0347 

0348 

0349 

0350 

0351 

0352 

0353 

0354 

0355 

0356 

0357 

0358 


0299 

0300 

0301 

0302 

0303 

0304 

0305 

0306 


DO  5000  I-4,1EN0>2 
CALL  ZDRAU(DAT(1>1>,DAT(I,2>> 
5000  CONTINUE 


C- 

C 

C 

C 

C- 


Chongc  tht  viewport  to  the  noxinun  posible  so  text  strings  nay  bs 
placed  anywhere  on  the  view  surface.  Output  the  text  strings,  then 
reset  the  viewport. 


6010 


C 

C 

C 

C 

c 


CALL  ERRMS  ( 1 , lERR ,6HZ0ESC  > 

CALL  2TEXT  (NMTEXT, TEXT) 

CALL  ZIESC< 3050 ,3,0, ILIST , RLIST, lERR ) 
IF  (lERR  .EQ.  0)  GO  TO  6020 
CALL  ERRNS  ( 1 , lERR ,6HZIESC  ) 

GO  TO  9999 


6020 


TEXT(l) 
TEXT (2) 
TEXT<3) 
TEXT(4) 
TEXT(S) 
TEXT (6) 
TEXT<7) 
TEXT<8) 
NHTEXT  > 
XTEXT  • 
YTEXT  - 
OPCODE  1 


-  2HAn 

-  2Hpl 
■  2Hlt 
*  2Hud 

-  2Hc 

-  2H<d 

-  2Hb) 

-  6412B 
16 

XNIN 
THIN  ♦ 
1050 
1 


(XMAX  -XHIN)/30.0 
<YHAX-YHIN)/2.0 


6030 


ILISTd) 

I8IZE  -  1 
RSIZE  =  0 

CALL  ZMOVt( XTEXT, YTEXT) 

CALL  ZOESC<OPCODE,ISIZE,RSIZE, ILIST, RLIST, lERR) 
IF  (lERR  .EQ.  0)  GO  TO  6030 
CALL  ERRNS  ( 1 , lERR ,6HZ0LSC  ) 

GO  TO  9999 

CALL  ZIEXT(NMTEXT,TEXT) 
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0307  6000 

CALL  UPHAX  (UIEU) 

1 

0308 

TEXT(l)  >  2HRe 

h 

0309 

TEXT<2)  -  2Hla 

0310 

TEXT(3)  »  2Hti 

*> 

0311 

TEXT(4)  -  2Hve 

0312 

TEXT<5)  -  2H  P 

0313 

TEXT(6)  -  2Hos 

.V 

Iti^ 

0314 

TEXT<7)  -  2Hit 

1 

0315 

TEXT<8)  >  2Hio 

0316 

TEXT<9)  «  2Hn 

g 

0317 

TEXTdO)  =  2H<n 

0318 

TEXTdl)  -  2Hn) 

O' 

0319 

TEXTd2)  ■  6412B 

& 

0320 

NMTEXT  =  24 

W 

0321 

XTEXT  =0.0 

r 

0322 

YTEXT  =  YMIN  ♦  < YMAX-YMIN)/2l . 0 

Ti 

0323  C 

0324 

CALL  ZMOVE  (XTEXT, YTEXT) 

0325 

OPCODE=1052 

h 

,  i 

0326 

ISIZE=1 

0327 

RSIZE=0 

0328 

ILISTd)=6 

^  h 

0329 

CALL  ZOESC<OPCODE, ISIZE, RSIZE, ILIST, RLIST, lERR) 

0330 

IF  (lERR  .EQ.  0)  GO  TO  6010 

I 
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0368 
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0373 
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0375 

0376 

0377 

0378 

0379 

0380 

0381 

0382 

0383 

0384 

0385 

0386 

0387 

0388 

0389 

0390 

0391 

0392 

0393 

0394 

0395 

0396 

0397 

0398 

0399 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0407 

0408 

0409 

0410 

0411 

0412 

0413 

0414 

0415 

0416 

0417 

0418 


6040 


9999 


OPCODE*1050 
ILISTll)  •  0 
ISIZE  •  1 
R8IZE  •  0 

CALL  ZOESCIQPCODE, ISIZE, RSIZE,ILIST,RLXST,IERR) 
IF  <I£RR  .EQ.  0)  GO  TO  6040 
CALL  ERRH8  ( 1 , lERR ,6HZ0ESC  ) 

GO  TO  9999 

CALL  ZVIEU  (VIEU<1),VIEU<2>,VIEU(3>,VIEU(4)> 
CALL  ZHCUR 

RETURN 

END 


C**t**f***ttt***ttt*W1f*ttM***f*****ttt*t******tt**t$**t*9****9$*$*** 

C 
C 
C 


PURPOSE  I 
DESCRIPTION! 


SUBROUTINE  CRRHS 
Tq  writ*  out  an  error  naasage 


This  subroutins  writes  an  error  nessoge  to  the  alphanuneric 
LU.  The  error  nunber  and  DCL  subroutine  nane  that  the  error 
occured  during  is  reported. 


CALLING  SEQUENCE:  CALL  ERRMS(ALPHLU, ERROR , 5UBR ) 
PARAMETERS! 


C 
C 
C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

c 

SUBROUTINE  ERRMS  ( ALPHLU, ERROR, SUBR > 

INTEGER  ALPHLU, ERROR, SUBR(3> 


ALPHLU ! 
ERROR! 

SUBR: 


I INTEGER ) } 
( INTEGER } f 

(INTEGER]; 


The  alphanuneric  LU 

The  error  nunber  of  the  error  to 
reported 

An  array  containing  the  nane  of 
the  subroutine  where  the  error  occured.)^ 


Write  out  the  error  nessage 
CALL  INCUR 

URITE(ALPHLU,100)  ERROR,  SUBR 
100  FORMAT!"  Error  •,I2,*  occured  in  subroutine 

RETURN 

END 


,3A2) 


Ct*$***9****9«*9tt******9**$**$*$*9$**$9*$9**9*$***$t***$$**$9$*$$$*$t$$$* 

C 
C 

c 


PURPOSE: 

DESCRIPTION! 


SUBROUTINE  CLEAR 

To  clear  the  alphonuneric  display 


This  subroutine  will  clear  the  alphanuneric  display 
of  a  HP  2647  or  HP  2648  terninol.  If  the  display  is 
not  a  HP  2647  or  HP  2648  then  the  call  has  no  affect. 


CALLING  SEQUENCE;  CALL  CLEAR 


-74- 


0419 

0420 

0421 

0422 

0423 

0424 

042S 

0426 

0427 

0428 

0429 

0430 

0431 

0432 

0433 

0434 

043S 

0436 

0437 

0438 

0439 

0440 

0441 

0442 

0443 

0444 

0445 

0446 

0447 

0448 

0449 

0450 

0451 

0452 

0453 

0454 

0455 

0456 

0457 

0458 

0459 

0460 

0461 

0462 

0463 

0464 

0465 

0466 

0467 

0468 

0469 

0470 

0471 

0472 

0473 

0474 

0475 

0476 

0477 

0478 


C  PARAHETERSi  NONE 

C 

C************************************************************************* 

c 

SUBROUTINE  CLEAR 

INTEGER  ILIST(7>,  STRINC(2>,  lERR 
REAL  DUMMY 
C 

C  ILI3T  >  Infornatlon  list  rcturntd  by  ZIWS 
C  lERR  -  Error  infornation  rsturncd  by  ZIUS  (not  used  hers) 

C  DUMMY  -  Real  infornation  returntd  by  ZIWS  (none  in  this  cast) 

C  STRING  -  Ocvies-dspsndsnt  connands  thot  clear  a  264X  terninal 


DATA  STRING  /15S50B, 

/  \ 

33B  *  ISOB 

esc  h 

(hone  cursor) 


15512B/ 

/  \ 

33B  *  112B 

esc  J 

(clear  display) 


c 

C  Inquire  the  status  of  the  alphanuneric  devicei 
C  upon  return,  IL1ST(4)  ■  -1  “■>  no  alpha  device, 

C  ■  0  =■>  it  is  disabled, 

C  ■  1  >■>  it  is  enabled, 

C  If  it  is  not  enabled,  just  return, 

C 

CALL  ZIUS  (7050, 7, 0,ILI6T, DUMMY, lERR) 

IF  (lERR  ,£0,  0)  CO  TO  7070 
CALL  ERRHS  ( 1 , lERR ,6HZ1U8  ) 

CO  TO  9999 

7070  IF  (ILIST(4)  ,ME.  1)  GOTO  9999 
C 

C  Alpha  device  is  enabled.  Make  sure  it  is  '264X'  type  then  clear, 

C 

IF  (ILISTd)  ,NE,  2H26)  GOTO  9999 

IF  ((ILIST(Z)  ,NE,  2H47)  .AND,  (IL1ST(2)  .NE.  2H4B)>  GOTO  9999 
CALL  ZALPH  (4, STRING) 

C 

9999  RETURN 
END 
C 

»«««««»*««»«««««««»«««**«*»«**»»*«««*»*»»***»*«**»«*««»*«»»««« 

c 

C  SUBROUTINE  VPMAX 


PURPOSE: 


DESCRIPTION: 


Set  the  viewport  to  the  naxinun  linits. 

The  current  viewport  is  saved  in  VIEW,  The  viewport 
is  then  set  to  the  naxinun  linits. 


C  CALLING  SEQUENCE:  CALL  VPMAX  (VIEW) 

C 

C  PARAMETERS; 

C  VIEW:  [REAL  ARRAY  OF  4);  This  array  contains  the 

C  viewport  before  it  was 

C  naxunized. 

C 

C*****************************t«****************************t******«****** 

c 


f.*  •**  jii^ ji*  *■*  *1*  *t*ii*i*i‘i*i‘i* 


I 


0479 

0480 

0481 

0482 

0483 

0484 

048S 

0486 

0487 

0488 

0489 

0490 

0491 

0492 

0493 

0494 

049S 

0496 

0497 

0498 

0499 

0500 

0501 

0502 

0503 

0504 

0505 

0506 

0507 

0508 

0509 

0510 

0511 

0512 

0513 


SUBROUTINE  UPMAX  (UIEU) 

REAL  UIEW(4) 

C 

INTEGER  I DUN 
REAL  AR(2>,  NEUX;  NEUY 
C 

C  IDUH  -  Ounny  uork  uarlobl« 

C  AR  -  T«np  hgldtr  of  the  aspect  ratio 

C  NEUX  -  Tonp  work  variable 

C  NEUY  -  Tenp  work  variable 

C 


C  Inquire  current  viewport  and  sove  it  in  orray  UIEU 
C 

CALL  Z1U8  <451.0,4>IDUN,VIEU,IERR) 

IF  (lERR  .EQ.  0)  GO  TO  8080 
CALL  ERRH8  < 1 , lERR ,6HZIUS  > 

CO  TO  9999 
C 

C  Inquire  the  noxinun  aspect  ratio 
C 

8080  CALL  ZIWS  <254 , 0,2, IDUH^AR > lERR > 

C 

C  Set  viewport  to  naxinun  dinensions 
C 

NEUY  »  1. 

NEUX  «  1. 

IF  (AR(2)  .LE.  1.)  NEUY  »  AR<2> 

IF  <AR<2)  .GT.  1.)  NEUX  »  i./AR(2) 

CALL  ZVIEU  (0.0, NEUX, 0.0, NEUY) 

C 

9999  RETURN 
END 
ENDO 


mmm! 


MUM 


&UK10  T-00003  IS  ON  CKOOOIS  USING  00020  BLKS  R^ODOO 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 


»»«$«»«*«»«««»»«$»»»«««»««*««*»«««»«««*»»»«$»««»«$»»$»«»«*««« 

GENERAL  PURPOSE  Sll  MEASUREMENT  PROGRAM 


Walter  Reed  Arny  Institute  of  Research 
Deportnent  of  Microwave  Research 
Walter  Reed  Arny  Medical  Center 
Washington,  DC 
20012 

♦■f++++++++++-*-+++-f  ♦+♦++++♦+++♦♦•+■♦■♦♦+ 


BYt  Technology-USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone:  (301)  292-2592 


This  progran  neaaures  Sll  at  every  frequency  in  the 
calibration  list.  It  also  provides  a  listing  of  the  data. 


PROGRAM  WRIO 


C  Define  block  connon  array  and  the  variables  which  are  in  the  arroy. 

C - 

c 

INTEGER  CRT, PRINT 

C0MNaN/ACS2C/  D( 10 ) ,CAL(6, 112) ,Fi ,F2 ,F3 , Ml ,M2,RP1 , RP2 , RP3,N0NLY, 
«CM(4,112) ,IHEAD<40),IDATC(15> 

DIMENSION  J<20),ITIME<15),IBUF<41),IREC(2),NBUF(41) 

EQUIVALENCE  <D, J) , <REC,IREG) 

CRT-1 

PRINT-6 

FF-20014B 

IRPT-O 


Display  heading  on  the  CRT. 


IHOME-15510B 

1CLEAR-15512B 

WRITC<CRT,9500)  IHOME,lCLEAR 
WRITE<CRT,910) 

910  FORMAT( 

tmx ,  -nttM***************************************************" , / , 

BlOX,"*  PROGRAM  WRIO  *",/> 

*10X,*«  GENERAL  PURPOSE  Sll  MEASUREMENT  PROGRAM 

»10X, "V******************************************************, 

»■“> 

C - 

C  Coll  subroutine  FILE2  to  read  the  block  connon  data  fron  the  disk 
C  file  and  transfer  it  to  the  array  AGS2C. 


I 


'  M9«  X  _  *  M  ■  ■  '.iL-  _P.  .  ->  .  . 


0Jk' 


0  0S9 
0060 
0061 
0062 
0063 
0064 
006S 
0066 
0067 
0068 
006? 
0070 
0071 
0072 
0073 
0074 
0  075 
0076 
0077 
0  078 
0079 
0080 
0081 
0082 
0083 
0084 
0  085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 


C  Display  th«  data  on  which  this  data  worn  acquired,  the  startinq  fraquancy, 
C  the  step  size,  and  the  nunber  of  steps  in  the  frequency  list. 

C - 

CALL  riL£2(l) 

WR1TE<CRT,1020)  (IDATECI),  I»l,i5) 

1020  F0RNAT(3/, "Calibration  dato  was  taken  on  .  ",15A2> 

C  URITE(CRT,1030)  D( 1) ,D(2> ,D(3> 

1030  FORHATd/,  "Startlnq  Freq.  ■  "F8.3"  MHx", 

»/,"Step  Size  •  *  F8.3"  HHz",/"No«ber  of  steps  ■  *13) 

URITE<CRT,1050) 

1050  FORHAT(3/ , "Do  you  wish  to  recalibrate  7  (YES/NO)  *) 

1AN8-2H 

READ  (CRT, 9502)  IAN8 
IF  <lAN8.CQ.2HyE)  CO  TO  9000 

C - 

C  Measure  and  correct  data. 

C - - - 

1500  WRITE  (CRT, 9500)  1H0HE,1CLEAR 
WRITE  (CRT, 1510) 

1510  FORMAT  ( 1/,5X , "Press  RETURN  to  stort  the  neasurenent.  _*) 

READ  (CRT, 9502)  IANS 
WRITE  (CRT, 1520) 

1520  FORMAT  (3/,5X, "Neasurenent  in  process.  “) 

1600  CALL  C0RS4(1,4,1) 

C - 

C  Print  heading  on  the  line  printer, 

C - 

URITC(PRINT,2000) 

2000  F0RMAT(2/, 

*10X,“* 

*10X,"»  Walter  Reed  Arny  Institute  of  Research  •"»/» 

*10X,"*  Departnent  of  Microwave  Research  ♦"f/» 

*10X,*»  Walter  Reed  Arny  Medical  Center  •"»/» 

klOX,"*  Washington,  DC  20012  «*,/> 

«10X,"» 

«10X, "t******************************************************") 

WRITE  (CRT, 9500;  IHOME,ICLEAR 
IF  (IRPT.GT.O)  GOTO  2055 
WRITE  (CRT, 2050) 

2050  FORMAT  ( 1/ ,5X , "Enter  first  line  of  title  fer  the  data  list.*, 

•2/, 5X, "(Press  RETURN  if  no  title  is  to  be  printed.)", 

*2/) 

REG>EXEC(1,401B,IBUF,41) 

IF  (IREC(2) .EQ.O)  GO  TO  2100 
LINE1-IREC(2) 

2055  WRITE  (PRINT, 9501) 

WRITE  (PRINT, 9503)  ( IBUF( I ) , I-l , LINEl ) 

WRITE  (CRT, 2060) 

2060  FORMAT  ( 1/ ,5X , "Enter  second  line  of  title  for  the  data  list.", 

42/, 5X, "Press  RETURN  if  no  second  line  is  to  be  printed.)", 

*2/) 

REC-EXEC(1 ,401B,NBUF,41) 

IF  (IREC(2) .EQ.O)  GO  TO  2100 
LINfc2-IRtG(2) 

WRITE  (PRINT, 9503)  (NBUF( I ) , I-l , LINE2 ) 

2100  CALL  FTIME  (ITIME) 

WRITE  (PRINT, 2105)  ( IT1ME( I ) , I -1 , 15 ) 

2105  FORMAT  ( 2/ , 1  OX ,  "Measurement  Date;  ",15A2) 


J 


•  •  •  w,-*  •  ' 


v.v 


■*i'‘.tt*J»i‘.li*.lii‘.ti*^».it*.fa-.»«»-l»»a«‘'J«*.i.*A»j«*j«-^^j. 


0119 

0120 

0121 

0122 

0123 

0124 

012S 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 


WRITE  (PRINT, 2110)  ( IDATE( I > , I-l ,  15) 

2110  FORMAT  <1/,10X, "Calibration  Oatti  ■,15A2) 

WRITE  (PRINT, 2500) 

2500  FORMAT  (3/, 

«10X,-  Frequtncy  Sll  VSWR  Return",/, 

*10X,“  (MHz)  - "15X"  Loss  (dB)",/, 

»10X,"  Magnitude  Phase",/) 

C - 

C  Print  the  data. 

C - 

CALL  CALF2(4,M,F) 

DO  3900  I«i,M 
IF  (IFBRKdDUM))  9100,3100 
3100  CALL  CALF2(2, 1,F) 

CALL  CP0L2<CM(1  I),X,Y) 
ySWR  ■  ((l+X)/(i-X)) 

RLOSS  «-10$ALOGT(X»«2) 

IF  (X.  GC.  0.9802)  X-0.9e02 
IF  (X  .CE.  0.98)  VSWR-100.0 
IF  (X  .GE.  0.98)  RLOSS  *0.174 
WRITE  (PRINT, 3200)  F ,X , Y , VSWR ,RLOSS 
3200  FORMAT  ( 1  OX ,F10 . 3 , 2X ,F10 . 4,2X, F9 . 1 , 5X ,F7 . 3,SX,F7 . 3 ) 

3900  CONTINUE 

WRITE  (PRINT, 9504) 

C - 

C  Ask  operator  if  he  wants  another  neosurenent. 

C - 

WRITE  (CRT, 4050) 

4050  FORMAT  (l/,5X,"Do  you  wish  to  noke  another  run  ?  (YES/NO) 

READ  (CRT, 9502)  IANS 
IF  (IANS.NE.2HYE)  CO  TO  9100 
IRPT»1 

WRITE  (CRT, 9500)  IHOME,ICLEAR 
GO  TO  1500 

C - 

C  Progran  tcrnination. 

C - 

9000  WRITE  (CRT, 9010) 

9010  FORMAT  (2/, "Ron  program  ACS02  for  new  calibration.") 

9100  WRITE  (CRT, 9110) 

9110  FORMAT  (3/,10X, 

g'sssessssss  program  wrio  terminated  *«$««»»«««") 


C  Fornat  statements. 

c - 

9530  ICMMAT  (2A2) 

.  9'..01  FO.<hAT  (LV) 

9502  ^•bf(rlAT  (rt2) 

9503  FOiv'MAT  (10X.4()A2) 

9504  FORMAT  (HI ) 

END 

BLOCK  DATA 

COMMON  /AGS2C/  1(2330) 

END 

ENDS 


I 

I 


6 


r. 


&UR11  T>00004  IS  ON  CH3276y  USING  00035  BLKS  R=>0176 


OOOi 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
0010 
0011 
0012 
0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0  024 
0025 
0  026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
OOSl 
0052 
0053 
0054 
0  055 
0056 
0057 
0  058 


KTN4, 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 


$«*$$******Xf*ttt*tt***$t*rt*t***f  *******$$********$**$***$*$** 

GENERAL  PURPOSE  S21  HEASUREMENT  PROGRAM 


FOR)  Walter  Reed  Amy  Institute  of  Research 
Department  of  Microwaue  Research 
Walter  Reed  Amy  Medical  Center 
Washington,  DC 
20012 

+++♦++♦♦♦+♦♦♦++♦♦+♦♦♦+++♦++++•♦-++♦♦+ 


Technology-USA,  Inc. 

P.Q.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone:  (301)  292-2592 


This  program  measures  S21  at  every  frequency  in  the 
calibration  list.  It  also  provides  o  listing  of  the  dota. 

**$$**$!*$$*tt*$*****$****$****$$$*$**$$$$*$$***$*$»*t$$****** 


PROGRAM  UR 11 


C  Define  block  common  array  and  the  variables  which  are  in  the  orray. 

C - 

c 

INTEGER  CRT, PRINT 

C0MM0N/AGS2C/  D< 1 0 ) ,CAL<6, 1 12) , FI , F2,F3 , Ml ,M2 ,RP 1 , RP2 , RP3 , NONLY , 
*CM(4,112),IHCAD<40),IDATC<15> 

DIMENSION  J(20),ITIME<15>,IBUF(41) ,IREC(2) ,NBUF(41) 

EQUIVALENCE  (D, J) , (REC,IREC> 

CRT-1 

PRINT-6 

FF-20014B 

IRPT-O 


Display  heading  on  the  CRT. 


IHOME-1S510B 

ICLEAR-1S512B 

WRITE<CRT,9S00)  IHOME,ICLEAR 
URITE<CRT,910) 

910  FORMAT! 

«10X, ,/ , 

•lOX,"*  PROGRAM  WRll 

tlOX,"*  GENERAL  PURPOSE  S21  MEASUREMENT  PROGRAM 

«10X,  ''************$*******tt****$$t$**«t*«t$*t*tL$t$*t**$tttt»» ,  ^  , 

- - 

C  Call  subroutine  FILE2  to  read  the  block  common  data  from  the  disk 
C  file  and  transfer  it  to  the  array  AGS2C. 


0059 
0060 
0061 
0062 
0063 
0064 
0065 
0  066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0  087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 


C 

C  Display  the  date  on  which  this  data  wos  acquired,  the  starting  frequency, 
C  the  step  size,  and  the  nunber  of  steps  in  the  frequency  list. 

C - 

CALL  FILE2(1) 

URITE(CRT,i020)  (lOATE(I),  I>i,i5> 

1020  F0RHAT<3/, ‘Calibration  data  was  taken  on  .  *,15A2) 

URZTE(CRT,1030)  D( 1 ) ,D(2> >0(3) 

1030  FORMATd/, ‘Starting  Freq.  =  ‘F8.3‘  MHz‘, 

»/,"Step  Size  -  “  F8.3‘  MHz‘,/‘NoMber  of  steps  -  ‘13) 

UR1TE(CRT,1050) 


1050  FORMAT(3/,‘Do  you  wish  to  recalibrate  ?  (YES/NQ)  ‘) 
1ANS»2H 

READ  <CRT,9502)  IANS 
IF  (IANS.Eq.2HYE)  GO  TO  9000 


Measure  and  correct  data. 

1500  WRITE  (CRT, 9500)  IHOME,ICLEAR 

WRITE  (CRT, 1510) 

1510  FORMAT  ( 1/ ,5X , "Press  RETURN  to  start  the  neasurenent. 

") 

READ  (CRT, 9502)  IANS 

WRITE  (CRT, 1520) 

1520  FORMAT  (3/,5X, "Measurenent  in  process.  ") 

1600  CALL  C0RS3(1,4,1) 

Print  heading  on  the  line  printer. 

URITE<PRINT,2000) 
2000  F0RMAT<2/, 


»iOX,‘*  **,/, 

yi0X,*y  Walter  Reed  Arny  Institute  of  Research  **>/> 

«10X,‘4i  Departnent  of  Microwave  Research  **>/> 

yi0X,”y  Walter  Reed  Arny  Medical  Center 

*10X,"*  Washington,  DC  20012 

♦iOX,-* 


«10X, ’yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy" ) 

WRITE  (CRT, 9500)  IHOME,ICLEAR 
IF  (IRPT.GT.O)  GOTO  2055 
WRITE  (CRT, 2050) 

2050  FORMAT  ( 1/ ,SX , "En ter  first  line  of  title  for  the  data  list.‘, 
«2/,5X, "(Press  RETURN  if  no  title  is  to  be  printed.  )‘, 

*2/) 

REG=EXEC(l,40iB,IBUF,41) 

IF  (IREG(2) .EQ.O)  GO  TO  2100 
LINE1>IREG(2) 

2055  WRITE  (PRINT, 9501) 

WRITE  (PRINT, 9503)  ( IBUF( I ) , 1-1 , LINEl ) 

WRITE  (CRT, 2060) 

2060  FORMAT  ( 1/,5X,  "Enter  second  line  of  title  for  the  data  list.", 
»2/,5X, "Press  RETURN  if  no  second  line  is  to  be  printed.)", 

*2/) 

REG==EXEC(1,401B,NBUF,41) 

IF  (IREG(2) .EQ.O)  GO  TO  2100 
LINE.2*IREG(2) 

WRITE  (PRINT, 9503)  <NBUF( I ) , I»1 ,LINE2) 

2100  CALL  FTIME  (ITIME) 

WRITE  (PRINT, 2105)  ( ITIME( I ) , 1=1 , 15 ) 

2105  FORMAT  ( 2/ , 1  OX , "Measurenent  Date:  ",1SA2) 


1 

-4 


-81- 


■% 


0119 

0120 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 


WRITE  (PRINT, 2110)  ( IDATE< I ) , I-l , 15) 

2110  FORHAT  ( 1/, lOX, 'Calibration  Dat* i  •,i5A2) 
WRITE  (PRINT, 2500) 

2500  FORHAT  (3/, 

»10X,*  Frtqucncy  S21 

*10X,"  (HHi)  - "4X' 

*10X,'  Magnitudo  Phaao",/) 


Inaertion',/, 
Loaa  (dB)*,/, 


C  Print  the  data. 

C - 

CALL  CALF2(4,H,F) 

DO  3900  I>1,H 
IF  (IFBRK(IDUH))  9100,3100 
3100  CALL  CALF2(2,1,F) 

CALL  CP0L2(CH(2,I),X,Y) 

RL0S3  — iO*ALOGT(X*X) 

IF  (X.  GE.  0.9802)  X-0.9802 
IF  (X  .GE.  0.98)  RL088  >0.174 
WRITE  (PRINT, 3200)  F,X,Y,RLOSS 
3200  FORHAT  ( lOX ,F10 .3,2X,F10 .4,2X,F9 . 1 ,7X ,F7 . 3) 
3900  CONTINUE 

WRITE  (PRINT, 9504) 


C  Aak  operator  if  ha  uanta  another  neoaurenent. 

C - 

WRITE  (CRT, 4050) 

4050  FORMAT  (l/,SX,*Do  you  wiah  to  nake  another  run  ?  (YES/NO) 
READ  (CRT, 9502)  IAN3 
IF  (IANS,NE,2HYE)  GO  TO  9100 
1RPT=1 

WRITE  (CRT, 9500)  IHOME,ICLEAR 
GO  TO  1500 


C  Program  termination. 

- - 

9000  WRITE  (CRT, 9010) 

9010  FORMAT  (2/, "Run  program  ACS02  for  new  calibrotion .  *) 
9100  WRITE  (CRT, 9110) 

9110  FORMAT  (3/,10X, 

»•«««««»»«««  program  URll  TERMINATED  *«««»«*«*«') 


C  Format  atatementa, 

C - 

9500  FORMAT  (2A2) 

9501  FORMAT  (2/) 

9502  FORMAT  (A2) 

9503  FORMAT  (10X,40A2) 

9504  FORMAT  (HI) 

END 

BLOCK  DATA 

COMMON  /AGS2C/  1(2330) 

END 

END* 
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0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

000? 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 
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SUBROUTINE  WR12<LUN ,ERRN ,FL3 ,K ,L ,PRCNM ,PRCNL> 

INTEGER  ERRN,PRGNH,PRGNL,CLOSP 
DIMENSION  PRGNM<PRGNL> 

LOGICAL  FL3 
CLOSP«iH> 

J»2H  ' 

1»ERRN/1000B 

IF  <I  .EQ,  0)  I^b 

IF  (I  ,LT.  10)  CO  TO  IS 

J-I-(I/10)*10+2H00 

I«I/10 

WR I TE  < LUN , 19 )  I ,  J , ERRN ,  (PRGNM< I ) , I»1 , PRGNL ) , CLOSP 

FORMAT  <1X, ’ERROR  ♦  UR’,I1,R1,"  -  ’,05,"  . (’,6A1) 

IF  <PRGNM<1)  .NE.  2HW  )  CO  TO  50000 
IF  (PRCNM<2)  .NE.  2HR  >  GO  TO  50000 
IF  <ERRN  .NE.  IIOIB)  GO  TO  1103 
WRITE  <LUN,1101) 

FORMAT  (IX, "Heidenhain  for  ZENITH  axis  is  not  set  to  ", 

K  "nillineter  position.") 

IF  <FL3)  WRITE  (LUN, 1102) 

FORMAT! IX, "Ploce  switch  in  'MM»  position  ond  rerun  ", 

1  "the  progran.") 

RETURN 

IF  (ERRN  .NE.  1102B)  GO  TO  1106 
URITE(LUN,1104) 

FORMAT! IX, "ProgroM  cannot  read  the  neasurenent " , 
t  "  units  fro«  the  ZENITH  axis  Heidenhain . " ) 

IF  (FL3)  WRITE  (LUN, 1105) 

FORMAT(lX,"S«t  the  power  control  leuer  on  the  right", 

>  "of  the  scanner  control  panel  to  'ON'.’) 

RETURN 

IF  ( (ERRN-1100B)/10  ,NE.  3)  GO  TO  1200 
WRITE  (LUN, 1107) 


0059  1107  FORHAT  ( IX, "HcXdcnhain  for  ZENITH  oxls  Is  sending  ■, 

0060  «  "trrentous  data.") 

0061  IF  (FL3)  WRITE  (LUN,1108> 

0062  1108  FORHAT  <lX,"Call  systsn  nanagsr  about  probltn  with", 

0063  »  "  the  VRZ-100  readout  device  for  ZENITH.") 

0064  RETURN 

0065  1200  IF  <ERRN  .NE.  1201B)  GO  TO  1203 

0066  URITE(LUN,1201) 

0067  1201  FORMAT  <1X, "Heidenhain  for  AZIMUTH  Axis  is  not  set  to  ", 

0068  t  "nillifieter  position.") 

0069  IF  <FL3)  WRITE  <LUM,1202) 

0070  1202  FORMAT! IX, "Place  switch  in  'MM^  position  and  rerun  the  progran.") 

0071  RETURN 

0072  1203  IF  (ERRN  .NE.  1202B)  GO  TO  1206 

00,3  WRITE(LUN,1204) 

0074  1204  FORMAT! IX, "Progran  cannot  read  the  neasurenent " , 

0075  •  "  units  fron  the  AZIMUTH  axis  Heidenhain.") 

0076  IF  (FL3)  WRITE  !LUN,1205) 

0077  1205  FORHAT!lX, "Set  the  power  control  lever  on  the  right", 

0078  «  "of  the  scanner  control  panel  to  'ON'.") 

0079  RETURN 

0080  1206  IF  ( !ERRN-1200B)/10  .NE.  3)  GO  TO  1400 

0081  WRITE  !LUN,1207) 

0082  1207  FORHAT  (IX , "Heidenhain  for  AZIMUTH  axis  is  sending  ", 

0083  *  "erroneous  data.*) 

0084  IF  (FL3)  WRITE  !LUN,1208) 

0085  1208  FORHAT  (IX, "Call  systen  nanager  about  problen  with", 

0086  «  ■  the  VRZ-100  readout  device  for  AZIMUTH.") 

0087  RETURN 

0088  1400  IF  (ERRN  .NE.  14018)  GO  TO  1403 

0089  WRIT£(LUN,1401) 

0090  1401  FORMAT  ( IX , "Heidenhain  for  ELEVATION  Axis  is  not  set  to  ", 

0091  «  "nillineter  position.") 

0092  IF  (FL3)  WRITE  (LUN,i402) 

0093  1402  FORMAT( IX , "Place  switch  in  'MM'  position  and  rerun  the  progran.*) 

0094  RETURN 

0095  1403  IF  (ERRN  .NE.  1402B)  GO  TO  1406 

0096  WRITE(LUN,1404) 

0097  1404  FORMAT( IX, "Progran  cannot  read  the  neasurenent", 

0098  «  "  units  fron  the  ELEVATION  oxis  Heidenhain.") 

0099  IF  (FL3)  WRITE  (LUN,1405) 

0100  1405  FORMAT( IX, "Set  the  power  control  lever  on  the  right", 

0101  *  "of  the  scanner  control  panel  to  'ON'.*) 

0102  RETURN 

0103  1406  IF  ( (ERRN-1400B)/10  .NE.  3)  GO  TO  3300 

0104  WRITE  (LUN,i407) 

0105  1407  FORMAT  ( IX, "Heidenhain  for  ELEVATION  axis  is  sending  ", 

0106  t  "erroneous  data.") 

0107  IF  (FL3)  WRITE  (LUN,14D8) 

0108  1408  FORMAT  (IX, "Call  systen  nanager  about  problen  with  ", 

0109  «  "VRZ-100  readout  device  for  ELEVATION.*) 

0110  RETURN 

0111  3300  IF  (ERRN  .NE.  3301B)  GO  TO  3303 

0112  WRITE(LUN,3301) 

0113  3301  FORMAT  (lX,"Farrand  for  ROTATION  Axis  is  not  set  to  ", 

0114  *  "right  setting.*) 

0115  IF  <FL3)  WRITE  (LUN,3302) 

0116  3302  FORMAT( IX , "Put  Farrand  in  right  setting  and  rerun  ", 

0117  *  "the  progran.") 

0118  RETURN 


Oil?  3303  IF  <ERRN  .NE.  3302B)  CO  TO  3306 
0120  URITE(LUN,3304) 

0121  3304  FORMATdX,  “ProqpOH  cannot  road  tht  naasurcntnt  ” , 

0122  «  *  units  fron  ths  ROTATION  axis  Farrand.**) 

0123  IF  (FL3)  WRITE  <LUN,330S) 

0124  3305  FORMATdX,  “Call  systcn  nanagsr  about  problon  with*, 

0125  *  “  ORZ-100  rsadout  dsvics  for  ROTATION.*) 

0126  RETURN 

0127  3306  IF  ( (ERRN-3300B)/10  .NE.  3)  CO  TO  6100 

0128  WRITE  <LUN,3307) 

0129  3307  FORMATdX,  “Farrand  for  ROTATION  axis  is  ssnding  *, 

0130  4  “erroneous  data.*) 

0131  IF  <FL3)  WRITE  (LUN,3308> 

0132  3308  FORMATdX,  “Call  systen  nanoger  about  probltn  with  *, 

0133  4  “the  URZ-iOO  readout  deuice  for  ROTATION.") 

0134  RETURN 

0135  6100  IF  <ERRN  .NE.  iOlB)  GO  TO  6103 

0136  WRITE<LUN,6i01> 

0137  6101  FORMAT  <1X, “Heidenhain  for  ZENITH  Axis  is  not  set  to  “, 

0138  4  “nillineter  position.*) 

0139  IF  (FL3)  WRITE  (LUN,6102) 

0140  6102  FORHAT< IX, “Place  switch  in  'MH'  position  ond  rerun  “, 

0141  4  “the  progran.*) 

0142  RETURN 

0143  6103  IF  <ERRN  .NE.  102B)  GO  TO  6106 

0144  WRITE<LUN,6104) 

0145  6104  FORHAT< IX, “Progran  cannot  read  the  neasurenent * , 

0146  4  “  units  fron  the  ZENITH  axis  Heidenhain.*) 

0147  IF  (FL3)  WRITE  <LUN,610S) 

0148  6105  FORMATdX,  “Coll  systen  nanoger  about  problen  with*, 

0149  4  “  the  VRZ-lOO  readout  device  for  ZENITH.*) 

0150  RETURN 

0151  6106  IF  (ERRN  .NE.  103B)  CO  TO  6109 

0152  WRITE  (LUN,6107) 

0153  6107  FORMATdX,  “There  is  no  power  to  the  ZENITH  notor.‘) 

0154  IF  <FL3)  WRITE  <LUN,6i08) 

0155  6108  FORMATdX,  “Set  the  power  control  lever  on  the  right", 

0156  4  “of  the  scanner  control  panel  to  'ON'.*) 

0157  RETURN 

0158  6109  IF  (ERRN  .NE.  104B)  GO  TO  6112 

0159  WRITE  <LUN,61i0) 

0160  6110  FORMAT  (IX, “The  COMPUTER/MANUAL  switch  is  not  set  to", 

0161  4  “  the  conpvter  position.*) 

0162  IF  (FL3)  WRITE  (LUN,6111) 

0163  6111  FORMAT  (IX, “Set  the  node  switch  to  the  conputer  position* 

0164  4  “  and  run  the  progran  again.*) 

0165  RETURN 

0166  6112  IF  (ERRN  .NE.  105B)  GO  TO  6115 

0167  WRITE  (LUN,6113) 

0168  6113  FORMATdX,  “Tine  out  while  rending  fron  the  “, 

0169  4  “ZENITH  axis  Heidenhoin . “ ) 

0170  IF  (FL3)  WRITE  (LUN,6114) 

0171  6114  FORMAT  (IX, “Call  systen  nanager  about  problen  with  *, 

0172  4  “the  VRZ-lOO  readout  device  for  ZENITH.*) 

0173  RETURN 

0174  6115  IF  (ERRN  .NE.  106B)  GO  TO  6118 

0175  WRITE  (LUN,6116) 

0176  6116  FORMAT  (IX, “Unable  to  reach  the  desired  ZENITH  “, 

0177  4  "position  after  1024  tries.*) 

0178  IF  (FL3)  WRITE  (LUN,6117) 


I 


! 


0179 

0180 

0181 

6117 

0182 

0183 

6118 

0184 

018S 

0186 

6119 

0187 

0188 

6120 

0189 

0190 

6121 

0191 

0192 

0193 

6122 

0194 

019S 

6123 

0196 

0197 

6200 

0198 

0199 

0200 

6201 

0201 

0202 

6202 

0203 

0204 

6203 

0205 

0206 

0207 

6204 

0208 

0209 

0210 

6205 

0211 

0212 

6206 

0213 

0214 

6207 

0215 

0216 

0217 

6208 

0218 

0219 

6209 

0220 

0221 

0222 

6210 

0223 

0224 

0225 

6211 

0226 

0227 

6212 

0228 

0229 

0230 

6213 

0231 

0232 

0233 

6214 

0234 

0235 

6215 

0236 

0237 

0238 

6216 

FORMAT  (iX,''Coll  systcn  nanagcr  about  probltn  with*, 

*  *  ZENITH  controller,  notor,  or  drive.*) 

RETURN 

IF  <ERRN  .NE.  HOB)  GO  TO  6121 
WRITE  <LUN,6119) 

FORMAT  (lX,*The  ZENITH  axis  direction  linit  switch  *, 

*  *has  been  tripped.*) 

IF  <FL3)  WRITE  (LUN,6120) 

FORMAT  (lX,*Movs  in  the  -  direction  on  ZENITH  axis.*) 

RETURN 

IF  (ERRN  .NE.  120B)  GO  TO  6201 
WRITE  <LUN,6122) 

FORMAT  <lX,*The  ZENITH  axis  -  direction  linit  switch  *, 

*  *has  been  tripped.*) 

IF  <FL3)  WRITE  (LUN,6123) 

FORMAT  <lX,*Movs  in  the  *  direction  on  ZENITH  axis.*) 

RETURN 

IF  (ERRN  .NE.  201B)  GO  TO  6203 
WR1TE<LUN,6201) 

FORMAT  (IX, "Heidenhain  for  AZIMUTH  Axis  is  not  set  to  *, 

*  *Nillineter  position.”) 

IF  (FL3)  WRITE  (LON, 6202) 

FORMAT ( IX, ‘Place  switch  in  'MH'  position  and  rerun  the  progran. 
RETURN 

IF  (ERRN  .NE.  202B)  GO  TO  6206 
WRIT£(LUN,6204) 

FORMAT( IX, *Pregran  cannot  read  the  neasurenent*, 

*  *  units  fron  the  AZIMUTH  axis  Heidenhain.*) 

IF  <FL3)  WRITE  (LUN,62I5) 

FOKMAT( IX, ‘Call  systen  nanager  obout  problen  with*, 

*  *  the  VRZ-lOO  readout  device  for  AZIMUTH.*) 

RETURN 

IF  (ERRN  .NE.  203B)  GO  TO  6209 
WRITE  (LUN,6207) 

FORMAT( IX, “There  is  no  power  to  the  AZIMUTH  notor.") 

IF  (FL3)  WRITE  (LUN,6208) 

FORMAT( IX, "Set  the  power  control  lever  on  the  right*, 

*  "of  the  scanner  control  panel  to  'ON'.") 

-•ETURN 

I  ;ERRN  .NE.  204B)  GO  TO  6212 
RITE  (LUN,6210) 

FORMAT  (IX, "The  COHPUTER/MANUAL  switch  is  not  set  to", 
b  "  the  conputer  position.") 

IF  (FL3)  WRITE  (LUN,6211) 

FORMAT  (iX,“Set  the  node  switch  to  the  conputer  position", 

*  "  and  run  the  progran  again.") 

RETURN 

IF  (ERRN  .NE.  20SB)  GO  TO  6215 
WRITE  (LUN,6213) 

FORMAT( IX, "Tine  out  while  reading  fron  the  ", 

«  "AZIMUTH  axis  Heidenhain. *) 

IF  (FL3)  WRITE  (LUN,6214) 

FORMAT  (IX, "Call  systen  nanager  about  problen  with  ", 

*  ‘the  VRZ-lOO  readout  device  for  AZIMUTH.") 

RETURN 

IF  (ERRN  .NE.  206B)  CO  TO  621B 
WRITE  (LUN,6216) 

FORMAT  (IX, "Unable  to  reach  the  desired  AZIMUTH  ", 

*  "position  after  1024  tries.") 

IF  <FL3)  WRITE  (LUN,6217) 


-86- 


0239  6217  FORMAT  (IX,  "Coll  systtn  nonogcr  about  problcn  with" 

0240  •  "  AZIMUTH  Motor,  controllor,  or  driut.") 

0241  RETURN 

0242  6218  IF  (ERRN  .NE.  210B)  GO  TO  6221 

0243  WRITE  (LUN,6219) 

0244  6219  FORMAT  <lX,"Th€  AZIMUTH  axis  +  direction  linit  switch  ", 

0245  *  "has  been  tripped.") 

0246  IF  (FL3)  WRITE  <LUN,6220) 

0247  6220  FORMAT  (IX, "Move  in  the  -  direction  on  AZIMUTH  oxis.") 

0248  RETURN 

0249  6221  IF  (ERRN  .NE.  220B)  CO  TO  6300 

0250  WRITE  (LUN,6222) 

0251  6222  FORMAT  (IX, "The  AZIMUTH  axis  -  direction  linit  switch  ", 

0252  *  "has  been  tripped.") 

0253  IF  (FL3)  WRITE  (LUN,6223) 

0254  6223  FORMAT  (IX, "Move  in  the  *  direction  on  AZIMUTH  axis.") 

0255  RETURN 

0256  6300  IF  (ERRN  .NE.  301B)  GO  TO  6303 

0257  WRITE(LUN,6301) 

0258  6301  FORMAT  (lX,"Farrand  for  ROTATION  Axis  is  not  set  to  ", 

0259  *  "right  setting.") 

0260  IF  (FL3)  WRITE  (LUN,6302) 

0261  6302  FORMATdX,  "Put  Farrand  in  right  setting  ond  rerun  ", 

0262  *  "the  progran.") 

0263  RETURN 

0264  6303  IF  (ERRN  .NE.  302B)  GO  TO  6306 

0265  URITE(LUN,6304) 

0266  6304  FORNAT( IX, "Progran  cannot  read  the  neasurenent " , 

0267  *  "  units  fron  the  ROTATION  oxis  Forrand.") 

0268  IF  (FL3)  WRITE  (LUN,630S) 

0269  6305  FORMAT( IX, "Call  systen  Manager  obout  problen  with", 

0270  *  "  VRZ-100  readout  device  for  ROTATION.") 

0271  RETURN 

0272  6306  IF  (ERRN  .NE.  303B)  GO  TO  6309 

0273  WRITE  (LUN,6307) 

0274  6307  FORMAT( IX, "There  is  no  power  to  the  ROTATION  Motor.") 

0275  IF  (FL3)  WRITE  (LUN,6308) 

0276  6308  FORMAT( IX, "Set  the  power  control  lever  on  the  right", 

0277  ♦  "of  the  scanner  control  panel  to  'ON'.") 

0278  RETURN 

0279  6309  IF  (ERRN  .NE.  304B)  CO  TO  6312 

0280  WRITE  (LUN,6310) 

0281  6310  FORMAT  (IX, "The  COMPUTER/MANUAL  switch  is  not  set  to", 

0282  *  "  the  conputer  position.") 

0283  IF  (FL3)  WRITE  (LUN,63il) 

0284  6311  FORMAT  (IX, "Set  the  node  switch  to  the  conputer  position" 

0285  •  "  and  run  the  progran  again.") 

0286  RETURN 

0287  6312  IF  (ERRN  .NE.  305B)  CO  TO  6315 

0288  WRITE  (LUN,6313) 

0289  6313  FORMATdX,  "Tine  out  while  reading  fron  the  ", 

0290  *  "ROTATION  axis  Farrand. ") 

0291  IF  (FL3)  WRITE  (LUN,6314) 

0292  6314  FORMAT  (IX, "Call  systen  Manager  about  problen  with  ", 

0293  *  "VRZ-lOO  readout  device  for  ROTATION.") 

0294  RETURN 

0295  6315  IF  (ERRN  .NE.  306B)  GO  TO  6318 

0296  WRITE  (LUN, 63.16) 

0297  6316  FORMAT  dX, "Unable  to  reach  the  desired  ROTATION  ", 

0298  t  "position  after  1024  tries.") 


4*A'i 


0299 

0300 

6317 

0301 

0302 

0303 

6318 

0304 

0305 

6319 

0306 

0307 

0308 

6320 

0309 

0310 

6321 

0311 

0312 

6322 

0313 

0314 

0315 

6323 

0316 

0317 

6400 

0318 

0319 

6401 

0320 

0321 

0322 

6402 

0323 

0324 

6403 

0325 

0326 

6404 

0327 

0328 

0329 

6405 

0330 

0331 

0332 

6406 

0333 

0334 

6407 

0335 

0336 

6408 

0337 

0338 

0339 

6409 

0340 

0341 

6410 

0342 

0343 

0344 

6411 

0345 

0346 

0347 

6412 

0348 

0349 

6413 

0350 

0351 

0352 

6414 

0353 

0354 

0355 

6415 

0356 

0357 

6416 

0358 

: 

IF  <FL3)  WRITE  <LUM,6317) 

FQRHAT  (IX, "Call  systtn  nanagcr  about  probltn  with", 

*  •  ROTATION  controller,  notor,  or  drive.*) 

RETURN 

IF  (ERRN  .NE.  310B)  CO  TO  6321 
WRITE  <LUN,6319) 

FQRHAT  (IX, "The  ROTATION  axis  CCW  direction  linit  switch 
M  "has  been  tripped.") 

IF  (FL3)  WRITE  (LUN,6320) 

FQRHAT  (iX,"Hove  in  the  CW  direction  on  ROTATION  oxis.") 
RETURN 

IF  (ERRN  .NE.  320B)  GO  TO  6400 
WRITE  (LUN,6322) 

FQRHAT  (iX,"The  ROTATION  axis  CM  direction  linit  switch  ' 

*  "has  been  tripped.*) 

IF  (FL3)  WRITE  (LUN,6323) 

FQRHAT  (IX.^Hove  in  the  CCW  direction  on  ROTATION  axis."] 
RETURN 

IF  (ERRN  .NE.  401B)  GO  TO  6403 
WRITE(LUN,640i) 

FQRHAT  (iX, "Heidenhain  for  ELEVATION  Axis  is  not  set  to  ‘ 
B  "nillineter  position.*) 

IF  (FL3)  WRITE  (LUN,6402) 

FORMAT( iX, "Place  switch  in  'HM*  position  and  rerun  the  pre 
RETURN 

IF  (ERRN  .NE.  402B)  GO  TO  6406 
URITE(LUN,64Q4) 

FURHAT( IX, "Progran  cannot  read  the  neasurenent ■ , 

»  *  units  fron  the  ELEVATION  axis  Heidenhain.") 

IF  (FL3)  WRITE  <LUN,640S) 

FOKHAT( IX, "Call  systen  nonager  about  problcn  with", 

«  *  VRZ-iOO  readout  device  for  ELEVATION.*) 

RETURN 

IF  (ERRN  .NE.  403B)  GO  TO  6409 
WRITE  (LUN,6407) 

FORHAT( IX , “There  is  no  power  to  the  ELEVATION  Motor.") 

IF  <FL3)  WRITE  (LUN,640B) 

FORHAT( IX, "Set  the  power  control  lever  on  the  right", 

*  "of  the  scanner  control  panel  to  'ON'.*) 

RETURN 

IF  (ERRN  .NE.  404B)  GO  TO  6412 
WRITE  (LUN,6410) 

FQRHAT  (IX, "The  COHPUTER/MANUAL  switch  is  not  set  to", 

*  "  the  conputer  position.") 

IF  (FL3)  WRITE  (LUN,6411) 

FQRHAT  (IX, "Set  the  node  switch  to  the  conputer  position* 

*  "  and  run  the  progran  again.*) 

RETURN 

IF  (ERRN  .NE.  40SB)  GO  TO  6415 
WRITE  (LUN,6413) 

FORHAT( IX, “Tine  out  while  reading  fron  the  ", 

«  "ELEVATION  axis  Heidenhain. ") 

IF  (FL3)  WRITE  (LUN,6414) 


RETURN 


“VRZ-IOO  readout  device  for  ELEVATION.") 


WRITE  (LUN,6416> 

FORMAT  (IX, "Unable  to  reach  the  desired  ELEVATION 
*  "position  after  1024  tries.*) 


0359 

IF  (FL3>  WRITE  (LUN,6417) 

0360 

6417 

FORMAT  (IX, "Call  syvtcn  Manager  about  preblen  with" 

0361 

t  "  ELEVATION  notor,  controller,  or  drive. 

") 

0362 

RETURN 

0363 

6418 

IF  (ERRN  .NE.  41 OB)  CO  TO  6421 

0364 

WRITE  (LUN,6419) 

0365 

6419 

FORMAT  (IX, "The  Elevation  axis  ♦  direction  linit 

switch  ", 

0366 

•  *ha«  been  tripped.*) 

0367 

IF  (FL3)  WRITE  (LUN,6420) 

0368 

6420 

FORMAT  (IX, "Move  in  the  -  direction  on  Elevation 

axis. ") 

0369 

RETURN 

0370 

6421 

IF  (ERRN  .NE.  420B)  CO  TO  50000 

0371 

WRITE  (LUN,6422) 

0372 

6422 

FORMAT  (IX, "The  Elevation  oxie  -  direction  linit 

switch  ", 

0373 

«  "has  been  tripped.”) 

0374 

IF  (FL3)  WRITE  (LUN,6423) 

0375 

6423 

FORMA*^  (iX,"Move  in  the  direction  on  Elevotion 

axis. ") 

0376 

RETURN 

0377 

50000 

RETURN 

0378 

END 
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0001 
0002 
0003 
0004 
OOOS 
0006 
0007 
•  008 
0009 
0010 
0011 
0012 
0013 
0014 
OOlS 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0  027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
003S 
0036 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0  053 
0054 
0055 
0056 
0057 
0058 


FTN4,L 

C  24998-18466  REV. 2040  <810304.1057) 

C 

C  PROGRAM  WRt3 

C 

C  DESCRIPTION! 

C  UR13  is  dtsiqncd  to  obtain  nicrowavt  transnission  data  at  difftrsnt 

C  points  along  a  scan  and  ot  different  angies  and  to  store  the  data 

C  in  a  disc  file. 

C  This  progran  has  been  divided  into  four  segments  because  it 
C  cannot  fit  into  memory  otherwise.  The  main  segment  always  remains 

C  in  memory.  The  main  segment  merely  colls  EXEC(8>UR13C)  to  read 

C  in  the  control  segment,  URi3C,  and  pass  control  to  it.  The  other 
C  two  segments  are  yRi3C,  which  plots  a  graph  on  the  plotter  and 

C  UR13T,  which  plots  a  groph  on  the  terminal.  Segment  UR13C  gives 

C  the  user  the  option  of  plotting  either  on  the  plotter  of  the  CRT 

C  for  each  run.  Therefor  eoch  run  uses  three  segments!  1.  the  moin 

C  segment,  WR13.  2.  the  control  segment,  WRi3C.  3.  a  graphing 
C  segment,  either  URi3G  or  UR13T.  The  two  segments  besides  the 
C  the  main  segment  overlay  each  other  by  one  segment  calling 
C  EXEC(8,  other  segment  name)  to  read  in  the  other  segment  over 
C  the  calling  segment  and  then  pass  control  to  it.  It  can 
C  return  to  the  calling  segment  only  by  calling  EX£C(8,  calling 
C  segment  name)  again. 

C  This  segment  is  the  main  segment.  It  is  run  by  typing  in! 

C  RU,UR13 

C  This  segment  only  defines  common,  initializes  variables,  and 
C  then  calls  CXEC(8,URi3C)  to  read  in  and  pass  control  to  segment 
C  UR13C. 

C 

C 

PROGRAM  URi3 
C 

dimension  DAT<3,520),IPRNH<4) ,INAME<3) ,IDCB<144) ,NAMEF(3) , 

*  IS1ZE<2),IT1TL(40),PLUNIT<2) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNM.INAME, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREa, 

*  lAEND, TEMPI, TEMP2,IRNUM,RSTEPS,IREND,PRESR0,IDCB,NAMEF, 

*  ISIZE,IDONE,IPEND,ISEND,POSITN,IPFLAG,IUFLAC,ID,IDRCT, 

*  PLUNIT,ITITL,PRNT,IGRLOC 
COMMON/ AGS2C/  D(10) 

IRNUM  -  1 
CRT  =  1 

IPRNM(l)  «  IHU 
IPRNM<2)  =•  IHR 
1PRNN(3)  »  IHl 
IPRNM<4)  «  1H3 
IPRNL  ■  4 
MESS  ■  -1 
ASTEPS  -  5 
lAEND  -  4 
RSTEPS  “  30 
IREND  >  3 

IPEND  =  1 
ISEND  -  i 
IDONE  ^  0 


I 

W 


.V 


wmmmm 


OOS?  PKLSAZ  -  999.9 

0060  IPFLAC  •  1 

0061  ILFLAG  «  1 

0062  PLUNlTd)  ■  4H  -  C 

0063  PLUNIT(2)  ■  4HRT 

0064  IGRLOC  •  i 

0065  NAHEFd)  -  2HSR 

0066  NAMEF(2)  ■  2HS2 

0067  NAMEF(3)  -  2Hif 

0068  PRNT  -  6 

0069  CALL  FILE2d) 

0070  TEMPI  -  D<i) 

0071  TEMP2  -  <D(3)  -  1)  «  0(2)  Dd> 

0072  RFREQ  -  0<1) 

0073  C - 

0074  C  Call  EXEC  to  road  in  soqnont  UR13C  and  pass  control  to  it. 

0075  C - 

0076  C 

0077  lCQDE-8 

0078  lNAHEd)«2HUR 

0079  1NAME<2)-2H13 

0080  INAME(3)>2HC 

0081  CALL  EXEC  (ICODE,  INAME) 

0082  END 

0083  C 

0084  C  Block  data  routins  for  AGS2C 
0085  C 

0086  BLOCK  DATA  ACS2C 

0087  COMMON  /ACS2C/  I <2330) 

0088  END 

0089  ENDO 
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0013 
0014 
0015 
0016 
0017 
0018 
0019 
0020 
0021 
0  022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0037 
0038 
0  039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
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0057 
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C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 
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c 

c 

c 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 
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»  SbGHtNT:  UR13C 

« 

*  FOR  I  Walter  Reed  Arny  Institutt  of  Research 

*  Departnent  of  Hicrowawe  Research 

*  Waiter  Reed  Arny  Hedical  Center 

*  Washington,  DC  20112 

« 

« 

«  BY:  Technology  USA,  Inc. 

«  P.O.  Box  55333 

*  Fort  Washington,  Maryland  20744 

«  Phone:  (301)  292-2592 


*  Segnent  UR13C  is  the  control  segnent  of  WRi3.  It  puts  * 

*  out  a  nenu  with  the  options:  * 

*  1  -  Enter  the  nunber  of  azinuth  steps  and  step  size.  B 

B  2  -  Enter  the  nunber  of  rotation  steps  and  step  size.  B 

B  3  -  Enter  the  nicrowaue  frequency.  B 

B  4  -  Set  antennae  to  a  new  azinuth  position.  B 

B  5  -  Rotate  antennae  to  a  new  angle.  B 

B  6  -  Enter  nunber  of  rcodings  to  average  for  each  point.  B 

B  7  -  Request  graphs  on  the  CRT.  B 

B  10  -  List  on  printer.  B 

B  8  -  Scan  fron  the  present  position  B 

B  9  -  Terninate  the  progran.  B 

B  After  8  is  chosen,  the  antennae  are  positioned  at  the  B 
B  present  position-(nonber  of  data  points-1 )Bstep  size/2.  B 
B  The  anplitude  and  phase  are  eoch  averaged  over  the  nunber  B 
B  of  readings  specified  in  6  and  saved  in  the  array  DAT  B 

B  along  with  the  position.  Then  the  antennoe  are  advanced  B 
B  by  step  size  and  the  anplitude  and  phase  are  reod  again.  B 
B  This  is  repeated  for  the  specified  nunber  of  steps  per  B 
B  scan .  B 

B  After  each  scan,  the  data  accunulated  in  array  DAT  is  B 
B  read  out  to  a  disc  file,  SRS21A.  If  there  is  a  file  B 

B  with  that  nane  already,  the  last  letter  is  increnented.  B 

B  After  the  data  is  read  out,  the  angle  is  increnented  by  B 
B  rotation  step  size  and  the  whole  process  repeated  for  B 

B  the  nunber  of  rotation  steps.  B 

B  B 

bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb 

PROGRAM  UR13C,5 

DIMENSION  DAT<3,52a),lPRNM(4) ,INAME(3) ,IDCB(144) ,NAHEF(3> , 

B  ISIZE<2) ,ITITL<40) , IREG<2) ,IFAT<3i20) ,PRNTL(2) , 

B  PLUNIT<2) ,FAT(1560) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNM, INANE, CRT, IPRNL,NESS, ICODE,PRESAZ,ASTEPS,RFREQ, 
B  lAEND, TEMPI , TEMP2, IRNUM,RSTEPS, 1REND,PR£SR0, 1DCB,NAMEF  , 

B  ISIZE , IDONE , IPEND, ISEND, POSITN , IPFLAC , ILFLAC , ID , IDRCT , 

B  PLUNIT, I riTL,PRNT,IGRLOC 

EQUIUALEHCE  (REG.IREG) , ( DAT , IFAT ) , ( DAT , FAT) 
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0059 
0060 
0061 
0062 
0063 
0064 
0  065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0  077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 

one 


c 

c- 


C0MM0N/AGS2C/  D<10)  ,CAL(6>112)  ,F1  ,F  2  ,F3  ,H1  ,M2,RP1 ,  R»>2  ,  RP3 ,  NONLY  , 
«CH<4,112),IHEAD(40),IDATl£(15> 

DATA  LUAZ/31/ , LURO/33/ ,11/154468/ 

6«t  nunbcr  of  scans  if  plots  rsqucstcd. 


IF  (PRESAZ  .EQ.  999.9)  CO  TO  525 
IF  (IGRLOC  .EQ.  1)  ILFLAC  «  0 
IF  (IDONE  .CE.  IREND)  CO  TO  515 
IF  (IFEND  .EQ.  1)  GO  TO  8701 
IF  (IDONE  .NE.  1)  CO  TO  511 
IF  (IPEND  .CT.  IREND)  GO  TO  513 
IPEND  -  1 


ISENO 

GO  TO  8701 
511  IF  (IDONE^^IPEND 
ISEND  -  IPEND 
GO  TO  8701 

ISEND  >  IREND  -  IDONE 
IPFLAG  -  -1 
GO  TO  8701 


GT.  TREND)  GO  TO  513 


513 


C  Reset  original  position  and  print  nenu. 

C - 

515  WRITE  (CRT,  519) 

519  FORMAT  (/,1X,"SCAN  IS  FINISHED* ,/, IX, 

*  "ANTENNAE  ARE  BEING  RESET  TO  THEIR  ORIGINAL  POSITION", 

*  /, IX, "PLEASE  EXCUSE  THE  DELAY") 

CALL  SETPO  (CRT,  LUAZ,  PRESAZ,  2,  lERR) 

IF  (lERR  .EQ.  0)  GO  TO  522 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

522  PRESRO  »  PRESRQ  -  RSTEPS$( IREND«1 ) 

CALL  SETPO  (CRT,  LURO,  PRESRO,  3,  lERR) 

IF  (lERR  .EQ.  0)  CO  TO  523 

CALL  WR12  (CRT,  lERK,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

523  IF  (IPFLAG  . EQ .  0)  GO  TO  525 
ISEND  >  1 
IPFLAG  »  1 
ILFLAG  »  1 
IDONE  «  0 


525 


Clear  screen  and  print  heading. 


C 
C- 

WRITE(CRT,529) 

0529  r'ORMATC" 

*  10X,5S»*',7, 

*10X, "*",20X, "PROGRAM  WR13",20X, "»" ,/, 

*i0X, "*",11X, "S21  LINE  AND  ANGLE  SCAN  PROGRAM" , IIX, "*",/ , 
*10X,5S»*' ,/) 

530  CALL  WRl  (CRT,  LUAZ,  PRESAZ,  lERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  540 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,  0,  IPRNM,  IPRNL) 

GO  TO  9090 

540  CALL  WR3  (CRT , LURO , PRESRO, lERR , 0 ) 

IF  (lERR  .EQ.  0)  GO  TO  550 

CALL  WRia  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

550  IF  (PRNT  .EQ.  0)  GO  TO  555 
PRNTL(i)  =  4H  PRI 
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0119 

0120 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

012? 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


PRNTL(2)  »  4HNT 
GO  rO  560 

555  PRNTL<1)  »  4HNO  P 
PRNTL(2)  »  4HRINT 

560  URITE(CRT,600>  lAENO, ASTEP3, IREND,RSTEPS ,RFREQ, PRESAZ 
»IRNUM,IPEN0,<PLUN1T<1),I-1,2),(PRNTL<1),I»1,2) 

0600  FORMAK"  PROGRAH  PARAMETER  ENTRY*, 30X,  “PRESENT  VALUES 

**  1  -  Nunbtr  of  azlHUth  steps  and  step  size . 

*13, “  x",F6.2,"  ««“,/, 

**  2  -  Nunber  of  rotation  steps  and  step  size.. . 

*13, “  x",F6.2,“  degrees*,/, 

**  3  -  Microwave  frequency . . . 

*F7.0,-  MHz",/, 

**  4  -  Azinuth  position . . . . 

*F8.3,*  M«*,/, 

**  5  -  Angle . . . . . . . 

*F0.3,“  degrees*,/, 

*"  6  -  Nunber  of  readings  to  average  per  point . 

**  7  -  Nunber  scans  per  graph . . . 

**  10  -  Toggle  switch  for  listing  on  printer . . 

*"  EXECUTION  OPTIONS*,/, 

*•  a  -  Scan  fron  the  present  position.*,/, 

♦*  9  -  Terninate  the  progran. *,/, **> 

610  WRITE  (CRT, 619) 

0619  FORMAT  <"*) 

620  WRITE  (CRT, 629) 

629  FORMAT  (IX, "SELECT  OPTION  NUNBER  “) 

READ(CRT,»)  IANS 
IF  (IANS  .Eq.  9999)  GO  TO  9090 
10)  GO  TO  700 
9)  GO  TO  9090 
8)  GO  TO  8000 
7)  GO  TO  7000 
6)  GO  TO  6000 
5)  GO  TO  5000 
4)  GO  TO  4000 
3)  GO  TO  3000 


PRESRO, 


,IS,/, 

,1S,1X,2A4,/, 

,2X,2A4,/, 


IF  (IANS 
IF  (IANS 
IF  (IANS 
IF  (IANS 
IF  (IANS  .EQ. 
IF  (IANS  .EQ. 
IF  (IANS  .EQ. 
(IANS 


IF 


.EQ. 

.EQ. 

.EQ. 

.EQ. 


.EQ. 

IF  (IANS  .EQ.  2)  GO  TO  2000 
IF  (IANS  .EQ.  1)  GO  TO  1000 
WRITE  (CRT, 659) 

659  FORMAT  (/, IX, "ERROR  •  WR13  -  15001  . ( WR 13) " , / , IX , 


"INCOPRTCT  RESPONSE.  ENTER  ANY  NUMBER  FROM  1  TO  10, 


GO  TC  620 


Set  to  print  on  the  printer. 


700 


750 


760 

769 


IF  (PRNT 
PRNT  a  6 
PRNTL(l) 

PRNTL(2) 

GO  TO  760 
PRNT  a  0 

PRNTL(l)  ■  4HN0  P 
PRNTL(2)  =  4HRINT 
WRITE  (CRT,769)  I 1 , (PRNTL( I ) , 1*1 , 2 ) 

FORMAT  (1A2,  "  "*  - - ‘ 

GO  TO  610 


EQ,  6)  GO  TO  750 

4H  PRI 
4HNT 


54c  13Y",2A4) 


■  H 

k  I 


t 


6^  ‘ 

v! 


Inquir€  the  useri  QTxnuth  ste  ora 


2/2 


017? 

0180 

0181 

0182 

0183 

0184 

0185 

0186 

0187 

0188 

0189 

0190 

0191 

0192 

0193 

0194 

0195 

0196 

0197 

0198 

0199 

0200 

0201 

0202 

0203 

0204 

0205 

0206 

0207 

0208 

0209 

0210 

0211 

0212 

0213 

0214 

0215 

0216 

0217 

0218 

0219 

0220 

0221 

0222 

0223 

0224 

0225 

0226 

0227 

0228 

0229 

0230 

0231 

0232 

0233 

0234 

0235 

0236 

0237 

0238 


1000  URITE(CRT»1100) 

1100  FORriAT</,''  Enttr  the  nunber  of  stops  per  scan.  ”) 

REA1>(CRT,«)  lAENO 

XF  (lAEND  .EQ.  9999)  GO  TO  9090 

IF  <(IAEND  .LT.  513)  .AND.  <IAEND  .GT.  0))  GO  TO  1190 
WRITE  (CRT, 1109) 

1109  FORNAT  (/, IX, 'ERROR  •  WR13  >  15202  . (UR13)',/, 

«  IX, 'THE  NUHBER  OF  STEPS  HOST  BE  FROH  1  -  512.',/, 

«  IX, 'REENTER  THE  NUHBER  OF  STEPS.') 

GO  TO  1000 

1190  URITE(CRT,1200) 

1200  FORHAT(/,'  Entor  tho  step  sizt  (nn> .  ') 

READ(CRT,«)  A8TEPS 
IF  (A8TEP8  .EQ.  9999)  GO  TO  9090 
WRITE  (CRT, 1209)  Il,IAENO,ASTEPS 
1209  FORMAT  (1A2, 'a  S2c  6Y',I3,'  *',F6.2) 

60  TO  610 

C - 

C  Inquire  fren  useri  rotation  step  size  ond  nunber  of  steps. 

C - 

2000  WRITE  (CRT, 2009) 

2009  FORMAT  </, IX, 'Enter  the  nunber  of  rototion  steps.  _') 

READ  (CRT,*)  IREND 
IF  (IREND  .EQ.  9999)  CO  TO  9090 
IF  (IREND  .GT.  0)  GO  TO  2028 
WRITE  (CRT, 2019) 

2019  FORMAT  (/, IX, 'ERROR  *  HR13  -  15302  . (WR13)',/, 

«  IX, 'THE  NUHBER  OF  STEPS  MUST  BE  GREATER  THAN  0.',/, 

*  IX, 'REENTER  THE  NUMBER  OF  ROTATION  STEPS.') 

GO  TO  2000 

2028  WRITE  (CRT, 2029) 

2029  FORMAT  (/, IX, 'Enter  the  rototion  step  size.  ') 

READ  (CRT,*)  RSTEP8 
IF  (RSTEPS  .Ea.9999)  GO  TO  9090 
WRITE  (CRT, 2039)  11,  IREND,  RSTEPS 
2039  FORMAT  (lA2,"a  52c  7Y',I3,'  z',F6.2) 

GO  TO  610 

C - 

C  Inquire  fron  the  user:  nicrowove  frequency. 

C - - 

3000  WR1TC<CRT,3500) 

3500  FORMAT(/,'  Enter  the  RF  frequency  (MHz)...  ') 

READ(CRT,*)  RFREQ 

XF  (RFREQ  .EQ.  9999)  GO  TO  9090 

IF  ((RFREQ  .CE.  TEMPI)  .AND.  (RFREQ  .LE.  TEHP2))  GO  TO  3600 
WRITE  (CRT, 3509)  TEHPl,  TEMP2 

3509  FORMAT  (/, IX, 'ERROR  •  MR13  -  15004  . (WR13) ' ,/, IX, 

*  'CALIBRATION  ONLY  FROM  ',F6.0,'MHz  TO  ' ,F6 . 0 , 'MHz . ' , 

*  /, IX, 'FREQUENCY  MUST  BE  BETWEEN  CALIBRATION  LIMITS.', 

*  /,lX,'Do  you  wish  to  recalibrate?  (YES/NO)  _') 

READ  (CRT, 3599)  IANS 

3599  FORMAT  (A2) 

IF  (IANS  .EQ.  2HYE)  GO  TO  9000 
GO  TO  3000 

3600  WRITE  (CRT,  3609)  II,  RFREQ 
3609  FORMAT  (lA2,'a  54c  8Y',F5.0) 

GO  TO  610 

C - 

C  Inquire  new  ozinuth  position  ond  coll  WR6  to  set  it. 


023?  4000  WRITE  (CRT, 4090) 

0240  4090  FORMAT  (/,iX, "Enter  n«M  position  (nn).  ") 

0241  READ  (CRT,*)  PRESAZ 

0242  IF  (PRESAZ  .EQ.  9999)  CO  TO  9090 

0243  CALL  SETPO  (CRT, LUAZ, PRESAZ, 2, lERR ) 

0244  IF  (lERR  .EQ.  0)  GO  TO  4400 

024S  CALL  UR12  (CRT, lERR, . TRUE. ,0, 0,IPRNM, IPRNL) 

0246  GO  TO  9090 

0247  4400  WRITE  (CRT, 4409)  II, PRESAZ 

0248  4409  FORMAT  (lA2,"a  S2e  9Y",F8.3) 

0249  GO  TO  610 

0250  C - - - 

0251  C  Inqsirs  n«w  rototion  and  call  WR6  t*  sat  it. 

0252  C - 

0253  5000  WRITE  (CRT, 5090) 

0254  5090  FORMAT  (/,iX, "Enter  new  angle...  _") 

0255  READ  (CRT,*)  PRESRO 

0256  IF  (PRESRO  .EQ.  9999)  GO  TO  9090 

0257  CALL  SETPO  (CRT,  LURO,  PRESRO,  3,  lERR) 

0258  IF  (lERR  .EQ.  0)  GO  TO  5500 

0259  CALL  WRi2  ( CRT, lERR, .TRUE. ,0,0, IPRNN, IPRNL) 

0260  GO  TO  9090 

0261  5500  WRITE  (CRT, 5509)  II,  PRESRO 

0262  5509  FORMAT  (iA2,"a  52c  i0Y",F8.3) 

0263  GO  TO  610 

0264  C - 

0265  C  Inquire  fron  the  user;  number  af  readings  per  data  paint. 

0266  C - 

0267  6000  WRITE  (CRT, 6009) 

0268  6009  FORMAT  (/,1X, 

0269  *  "Enter  number  af  readings  ta  averoge  per  dato  paint.  .") 

0270  READ  (CRT,*)  IRNUM 

0271  IF  (IRNUM  .EQ.  9999)  GO  TO  9090 

0272  IF  ((IRNUM  .LE.  32767)  .AND.  (IRNUM  .CT.  0))  CO  TO  6600 

0273  WRITE  (CRT, 6509) 

0274  6509  FORMAT  (/, IX, "ERROR  #  WR13  -  15005  . (WR13)",/, 

0275  *  IX, "NUMBER  TO  AVERAGE  MUST  BE  FROM  1  -  32767.",/, 

0276  «  IX, "REENTER  NUMBER  OF  READINGS  TO  AVERAGE  PER  POINT.") 

0277  GO  TO  6000 

0278  6600  WRITE  (CRT,  6609)  II,  IRNUM 

0279  6609  FORMAT  (lA2,"a  52c  11Y",I5) 

0280  GO  TO  610 

0281  C - 

0282  C  Inquire  fram  user;  number  af  scans  per  graph. 

0283  C - 

0284  7000  WRITE  (CRT, 7009) 

0285  7009  FORMAT  (/, IX, "Enter  number  af  scons  between  grophs.  ") 

0286  READ  (CRT,*)  IPEND 

0287  IF  (IPEND  .EQ.  9999)  CO  TO  9090 

0288  IF  (IPEND  .CE.  0)  GO  TO  7500 

0289  WRITE  (CRT, 7209) 

0290  7209  FORMAT  (/, IX, "ERROR  •  WR13  -  15003  . (UR13)",/, 

0291  «  IX, "NUMBER  OF  SCANS  CAN  NOT  BE  LESS  THAN  0*,/, 

0292  «  IX, "REENTER  NUMBER  OF  SCANS  BETWEEN  GRAPHS.") 

0293  GO  TO  7000 

0294  7500  WRITE  (CRT, 7509) 

0295  7509  FORMAT  (/, IX, "Enter  »1»  ta  plat  an  CRT  ", 

0296  «  "or  'O'  to  plot  on  platter.  ") 

0297  READ  (CRT,*)  IGRLOC 

0298  IPFLAG  »  1 


029?  PLUNXTd)  •  4H-PL0 

0300  PLUNir<2>  -  4HTTER 

0301  IF  <1GRL0C  .NE.  i)  GO  TO  7S50 

0302  PLUNlTd)  -  4H  -  C 

0303  PLUN1T(2)  -  4HRT 

0304  7550  IF  (IPEND  .NE.  0)  CO  TO  7600 

0305  IPFLAG  -  0 

0306  PLUNIT<i)  >  4HGRAP 

0307  PLUNIT(2)  >  4HH8 

0308  7600  ISEND  -  1 

0309  URITE  (CRT,  7609)  II,  IPEND,  (PLUNIT( X > , X>i ,2) 

0310  7609  FORHAT  <lA2,"a  S2c  12Y*,I5,1X,2A4> 

0311  GO  TO  610 

0312  C - 

0313  C  8«t  antenna*  t*  flrat  position  and  creot*  disc  data  fils. 

0314  C - 

0315  8000  URITE  (CRT, 8009)  (ITITL(I), 1-1,40) 

0316  8009  FORHAT  </,lX, 

0317  «*Ent*r  title  of  fils  or  press  'RETURN^  key  for  following  title.*, 

0318  «/,40A2,/) 

0319  REG  «  EXEC  (1 ,401B,ITlTL,-e0) 

0320  IF  (IREC<2)  .EQ.  0)  CO  TO  8100 

0321  DO  8050  I  -  ( IREG(2)-t3)/2,40 

0322  8050  ITlTL(l)  -  2H 

0323  IF  <(IREG(2)/2)«2  .EQ.  XREG(2))  CO  TO  8100 

0324  ITITL(lREC(2)/2-d)  -  <ITlTL(lREG(2)/2+l)/256)*256  ♦  32 

0325  8100  P081TN  -  PRESAZ-A8TEP3*(IAEND-1 )/2 

0326  PARAH  -  P08ITN 

0327  CALL  UR6<PARAM,IERR,2,0) 

0328  IF  (lERR  .EQ.O)  GO  TO  8200 

0329  CALL  UR12<CRT,IERR, .TRUE. ,0,0, IPRNH,ZPRNL) 

0330  CO  TO  620 

0331  8200  CALL  CALF2(3,  HC,  RFREQ) 

0332  I8IZE<2)  -  IAEND06  *  20 

0333  IF  <ISIZE<2)  .LT.  128)  ISIZE(2)  -  128 

0334  ISlZEd)  -  <ISIZE(2)  «  (IREND  +  1)  -f  127)/128 

0335  8300  NAHEF(3)  -  NAHEF<3)  *  1 

0336  CALL  CREAT  < IDCB, IERR,NAHEF, ISIZE,2) 

0337  IF  (lERR  .GE.  0)  GO  TO  8450 

0338  IF  (lERR  .EQ.  -2)  CO  TO  8300 

0339  URITE  (CRT, 8409)  lERR 

0340  8409  FORHAT  (/, IX, -ERROR  »'‘,I3,”  OCCURED  IN  8UBROUTINE  CREAT*) 

0341  GO  TO  9090 

0342  8450  IF  (PRNT  .EQ.  0)  CO  TO  8500 

0343  URITE  (PRNT, 8459)  ITITL,NAHEF 

0344  8459  FORHAT  ( *1  * ,40A2,/ , IX, *FILE  -  *,3A2) 

0345  URITE  (PRNT, 600)  IAEND,ASTEP8, IREND, R8TEP8, RFREQ, PRE8AZ,PRE8R0, 

0346  *  IRNUH, IPEND, PLUNIT,PRNTL 

0347  8500  URITE  (CRT, 8509)  NAHEF 

0348  8509  FORHAT  (/,1X,-NAHE  OF  DATA  FILE  18  *,3A2) 

0349  CALL  FTINE(IFAT) 

0350  DO  8550  1-1,40 

0351  8550  IFAT(15-tI)  -  ITITL(I) 

0352  IFAT(56)  -  2HR0 

0353  1FAT(57)  -  0 

0354  IFAT(58)  -  lAEND 

0355  FAT(30)  -  ASTEPS 

0356  IFAT(61)  -  0 

0357  IFAT(62)  -  TREND 

0358  FAT(32)  -  RSTEPS 


0359 

0360 

0361 

0362 

0363 

0364 

0365 

0366 

0367 

0368 

0369 

0370 

0371 

0372 

0373 

0374 

0375 

0376 

0377 

0378 

0379 

0380 

0381 

0382 

0383 

0384 

0385 

0386 

0387 

03B8 

0389 

0390 

0391 

0392 

0393 

0394 

0395 

0396 

0397 

0398 

0399 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0407 

0408 

0409 

0410 

0411 

0412 

0413 

0414 

0415 

0416 

0417 

0418 


FAT(33)  «  RFREQ 
IF6T<67)  ■  ISIZE(l) 

IFAT(68)  a  ISZZE(2) 

ILFLAG  -  1 

CALL  WRITF  (IDCB,  lERR,  DAT) 

IF  <IERR  .EQ.  0)  GO  TO  8700 
WRITE  <CRT,8609)  XERR 

8609  FORHAT  (/, IX, "ERROR  *  •,13,“  OCCURED  IN  SUBROUTINE  WRITF") 

GO  TO  9090 

- - 

C  Rotation  scan  fron  PRE8R0  ts  PRESRO-t-RSTEPSOdREND-l)  or  until  Qraph  nosdsd. 

8700  IF  (IPEND  .EQ.  0)  I8END  -  IREND 
ID  -  1 

IDRCT  -  1 

8701  DO  8900  J-l,ISENO 

IF  (J  *  IDONE  .EQ.  1)  GO  TO  8720 
IDRCT  ■  -IDRCT 
PRESRO  ■  PRESRO  R8TEP8 
PARAN  •  PRESRO 
CALL  WR6  <PARAH,  lERR,  3,  0) 

IF  <IERR  .EQ.  0)  CO  TO  8720 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

8720  CALL  WR3  (CRT,  LURO,  TRURO,  lERR,  0) 

IF  (lERR  .EQ.  0)  CO  TO  8725 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

CO  TO  9090 


C  Axinwth  scan  fron  PRESAZ-A8TEP5«(lAEND-i>/2  to  PRE8AZt>A8TEP8«tIAEN0-l>/2 
C - - - - - - - 

8725  DO  8800  Ial,IAEND 

IF  (IFBRK(IERR))  9090,8730 
8730  CALL  WRl  (CRT,  LUAZ,  TRUAZ,  lERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8735 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

C  CALL  CALF2(2,1,F) 

8735  XAUE  •  0. 

YAVE  •  0. 

DO  8750  K-1,IRNUH 

CALL  ME8UR(RFREQ,  XI,  Yl,  X,  Y) 

CALL  CORCT(HC,  XI,  Yl,  X,  Y) 

YAVE  ■  YAVE  ♦  Y 
8750  XAUE  a  XAVE  *  X 

XAVE  a  XAVE  /  IRNUH 
YAVE  a  YAVE  /  IRNUM 

RL0S8  a-ioOALOGKXAVEOXAVE  ♦  YAVEOYAVE) 

PHASE  a  ATAN2(YAVE,  XAVE)  «  180 . /3. 141593 

IF  (ILFLAG  .EQ.O)  GO  TO  8780 

WRITE  (CRT, 8779)  I , TRUAZ, RL088, PHASE 

8779  FORMAT  ( IX, "STEP " , 12, "  AZIMUTH  a«,FB.3, 

*  •  RL088  PHASE  a»,FB.3) 

8780  DAT(1,ID)  »  TRUAZ 
DAT (2, ID)  a  RLOSS 
DAT (3, ID)  a  PHASE 

IF  (1  .CE.  lAENO)  CO  TO  8800 
ID  a  ID  +  IDRCT 

POSITN  a  POSITN  ♦  IDRCT  «  ASTCPS 
PARAH  a  POSITN 


-98- 


» 


ii 

u 


0419  CALL  UR6(PARAM,XERR,2,0) 

0420  IF  (ZERR  .EQ.O)  60  TO  8800 

0421  CALL  UR12<CRT,1ERR,.TRUE.,0«0,ZPRNH,IPRNL) 

0422  GO  TO  9090 

0423  8800  CONTINUE 

0424  - - 

042S  C  End  of  oziniuth  scan  loop. 

0426  - - 

0427  DAT(l,IAEND-t-l)  -  TRURO 

0428  0AT(2,IAEND-fl)  -  RFREQ 

0429  IF  (PRNT  .EQ.  0)  60  TO  8850 

0430  WRITE  (PRNT, 8829)  TRURO,  RFREQ 

0431  8829  FORMAT  <//,SX, "ROTATION  F8. 3, 5X, "FREQUENCY  -",F6.0> 

0432  DO  8830  IE  -  1,  lAENO 

0433  8830  WRITE  (PRNT, 8839)  (DAT(I, IE) ,1-1,3) 

0434  8839  FORMAT  (IX, "AZIMUTH  «*,F8.3,SX, -RL0S8  -■,F8. 3,5X, "PHASE  -",F8.3) 

0435  8850  CALL  WRITF  (IDCB, ZERR, DAT) 

0436  IF  (lERR  .EQ.  0)  GO  TO  8900 

0437  WRITE  (CRT, 8859)  lERR 

0438  8859  FORMAT  (/, IX, "ERROR  •  *,I3,"  OCCURED  IN  SUBROUTINE  WRITF") 

0439  60  TO  9090 

0440  8900  CONTINUE 

1441  C - 

0442  C  End  of  rotation  scan  loop 

0443  C - - 

0444  IDONE  «  IDONE  18END 

0445  IF  (IPFLAG  .LT.  1)  GO  TO  515 

0446  - - 

0447  C  Call  EXEC  to  ovtrloy  this  saquant  with  WR13C 

0448  C - 

0449  8990  IF  (IGRLOC  .EQ.  1)  GO  TO  8995 

0450  1NAME(3)  •  2HG 

0451  GO  TO  8998 

0452  8995  INAME(3)  -  2HT 

0453  8998  CALL  EXEC  (ICODE, INANE) 

0454  9000  WRITE  (CRT, 9009) 

0455  9009  FORMAT  (2/, IX, "Run  progran  ACS02  for  nsw  calibrotlon . * ) 

0456  9090  WRITE  (CRT, 9099) 

0457  09099  FORMAT  (3/,10X, 

0458  «"«««*««««*«  PROGRAM  WR13  TERMINATED  *»»S«»*»»«") 

0459  CALL  CLOSE  (IDCB) 

0460  END 

•461  C - 

0462  C  Subroutine  SETPO  calls  WR6  to  sat  an  azinuth  or  alauotion  position 
0463  C  end  then  calls  WRl  to  check  the  position.  If  it  is  within  .002  it 
0464  C  returns,  if  not  it  calls  WR6  once  again. 

0465  C - 

0466  SUBROUTINE  SETPO(CRT, LU, PRES, UNIT, lERR ) 

0467  DO  100  1-1,2 

0468  PARAM  -  PRES 

0469  CALL  WR6  (PARAM, lERR , UNIT, 0) 

0470  IF  (lERR  .NE.  0)  RETURN 

0471  IF  (I  .GT.  1)  RETURN 

0472  IF  (LU  .EQ.  33)  GO  TO  90 

0473  CALL  WRl  (CRT,LU,NEW,IERR,0) 

0474  GO  TO  91 

0475  90  CALL  WR3  (CRT,LU,NEW, lERR, 0) 

0476  91  IF  (lERR  .NE.  0)  RETURN 

0477  IF  (ABS(NEW-PRES)  ,LT.  .002)  RETURN 

0478  100  CONTINUE 


9479 

048t 

0481 


RETURN 

END 

END* 
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4UN13C  T*00004  IS  ON  CR00002  USING  00084  BLKS  R>0S2i 


0001  FTN4>L 

0002  C  «*««»»« 

0003  C  « 

0004  C  * 

OOOS  C  « 

0006  C  « 

0007  C  «  FORt 

0008  C  « 

0009  C  « 

0010  C  * 

0011  C  « 

0012  C  « 

0013  C  « 

0014  C  «  BYi 

0015  C  » 

0016  C  « 

0017  C  « 

0018  C  * 

0019  C  «  - 

0020  C  «  Segnent  WR13C  is  the  ccqncnt  of  WR13  that  plota  a  * 

0021  C  «  groph  on  the  plotter.  It  is  read  in  and  control  passed  « 

0022  C  *  to  it  by  an  EXEC(8,UR13G>  call  fron  segnent  WR15C  after  » 

0023  C  »  a  scan  is  finished.  UR13G  then  plots  a  graph  on  the  « 

0024  C  «  plotter  of  the  attenuation  versus  position  for  each  « 

0025  C  «  frequency  with  a  norker  equal  to  the  frequency  nunber.  « 

0026  C  *  When  this  segnent  is  finished,  it  calls  EXEC(8,WR13C>  to  B 

0027  C  «  read  in  MR13C  and  pass  control  to  it.  « 

0028  C  t  * 

0  029  C  OBBSttB******************************************************* 

0030  PROGRAM  WR13G,5 

0031  C 

0032  DIMENSION  0AT< 3,520 ), IPRNM<4) , INAME(3) , IDCB( 144) ,NAHEF<3> , 

0033  «  ISIZE<2),ITITL<40),PLUNIT(2) 

0034  INTEGER  STATUS,  ALPHLU,  GOUTLU,  CRT,  PRNT 

0035  COMMON  OAT , IPRNM , INANE , CRT , IPRNL , MESS , ICOOE , PRESAZ , ASTEPS , RFREQ , 

0036  «  lAEND, TEMPI, TEMP2,IRNUH,RSTEPS,IREND,PRESR0,IDCB,NAMEF, 

0037  »  ISIZE,IDONE,IPEND,ISEND,POSITN,IPFLAC,ILFLAC,ID,IDRCT, 

0038  «  PLUNIT,ITITL,PRNT,IGRLDC 

0039  .  DATA  ALPHLU,  GOUTLU  71,19/ 

0040  C  / 

0041  C  STATUS  -  Set  to  zero  if  no  errors  occur  in  a  called  routine 

0042  C  ALPHLU  -  The  LU  of  the  alphanuneric  device 

0043  C  [gOUTLU  -  The  LU  of  the  graphics  output  device 

0044  C  / 

0045  C*i**9****t**$************************************************************ 

0046  C  / 

0047  CA - 

0048  yC  Initialize  DGL  systen 

0Oil9^C - 

0050  URITE<CRT,520) 

0051  0520  FORMATC") 

0052  CALL  ZBECN 

0053  C - 

0054  C  Enable  all  devices,  exit  if  any  errors 

0055  C - 

0056  CALL  ENDEU  < ALPHLU, GOUTLU, STATUS) 

0057  IF  (STATUS  . NE .  0)  GOTO  9990 

0058  C - 


SEGMENT:  WR13G 
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0057  C  Find  nininun  and  naxinun  values. 

0060  C - 

0061  XHIN  «  0AT<1,1) 

0062  XHAX  •  DAT(1,1AEN0) 

0063  YHIN  -  iOOOOO. 

0064  YHAX  ■  -YHIN 

0065  DO  5100  1-1,  lAENO 

0066  IF  (OAT<2,I)  .GT.  YHAX)  YHAX  •  DAT(2,I) 

0067  IF  <0AT(2»I)  .LT.  YHIN)  YHIN  >  DAT(2,I) 

0068  5100  CONTINUE 

0069  IF  (AB8(YHIN)  .NE.  YHIN)  CO  TO  5300 

0070  YHIN  ■  INT  <YHIN) 

0071  GO  TO  5400 

0072  5300  YHIN  -  INT  <YHIN  -  .999) 

0073  5400  IF  (AB8<YHAX)  .NE.  YHAX)  GO  TO  5500 

0074  YHAX  ■  INT  <YHAX  ♦  .999) 

0075  GO  TO  5600 

0076  5500  YHAX  -  INT  <YHAX) 

0077  5600  IF  <<YHAX-YHIN)  .LT.  6.)  YHAX  -  YHIN  ♦  6. 

0078  IF  <ABS<XHIN)  .NE.  XHIN)  GO  TO  5700 

0079  XHIN  ■  INT  <XHIN) 

0080  GO  TO  5800 

0081  5700  XHIN  ■  INT  (XHIN  -  .999) 

0082  5800  IF  <ABS<XHAX)  .NE.  XHAX)  GO  TO  5900 

0083  XHAX  ■  INT  (XHAX  ♦  .999) 

0084  CO  TO  5950 

0085  5900  XHAX  «  INT  (XHAX) 

0086  C - 

0087  C  Ptrfern  ths  vitwinc  transfQrnotion>  exit  if  ony  errors 

0088  - - 

0089  5950  CALL  WIEMT  (STATUS, XHIN, XHAX, YHIN, YHAX) 

0090  IF  (STATUS  .NE.  0)  GOTO  9990 

0091  C - 

0092  C  Draw  axis  and  label,  then  plot. 

0093  - - 

0094  CALL  DRWOT(XHIN, XHAX, YHIN, YHAX, DAT, lAEND) 

0095  GO  TO  9000 

0096  C - - 

0097  C  Disable  logical  devices 

0098  - - 

0099  C6000  CALL  ZNEUF 

0100  C  CALL  CLEAR 

0101  6000  CALL  ZAEND 

0102  CALL  ZDEND 

0103  CALL  ZEND 

0104  C - - 

0105  C  Call  EXEC  to  ovcrldy  this  seqnent  with  UR13C  and  execute  it. 

0106  C - Y - - - 

0107  9000  INAHE(3)  «  2HC/ 

0108  CALL  EXEC  (ICODE,  INAHE) 

0109  9990  CONTINUE  / 

0110  C  '  / 

0111  CALL  ZAEND^ 

0112  CAU^ZDEND 

0113  C - 

0114  C  Disable  DGL  systen 

oils  C - 

0116  CALL  ZEND 

0117  - - 

0118  C  Terninate  progran 


fcwwwrj«w.v; 


0119 

0120 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


■RSBBRonntnnRiuuRjn. . 


9998  URITE<CRT,9999> 

9999  FORMAT<*") 

END 


PURPOSE  I 


DESCRIPTION! 


ENDEV  SUBROUTINE 

This  subrsvtins  snablss  all  logical  devices  used  by 
the  progran. 

This  subroutine  enobles  the  DCL  work  station.  The  DCL 
workstation  contains  alphanuneric  and  graphics  output 
devices. 


CALLING  SEQUENCE:  CALL  ENDE9(ALPHLU,G0UTLU, STATUS) 


C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 

c 

SUBROUTINE  ENDEV <  ALPHLU  ^GOUTLU , STATUS > 


PARAHETERS: 


ALPHLU I 
GOUTLU : 
STATUS! 


[INTEGER])  Alphanuneric  LU 
[INTEGER])  Graphics  output  LU 
[INTEGER])  Set  to  zero  if  no  errors  occur 
during  initialization  of  the 
workstotion.  It  is  set  to  the 
DCL  error  return  value  if  an 
error  is  found. 


INTEGER  ALPHLU,  GOUTLU, 
INTEGER  CONTRL 


STATUS 


C - 

C  If  an  error  occurs,  write  out  on  error  nessage,  and  return. 

C 

C  Enable  alphanuneric  device 

C - 

C  CALL  ZAINT  (ALPHLU, STATUS) 

C  IF  (STATUS  .EQ.  0)  GOTO  1000 
C  CALL  ERRNS  (ALPHLU,STArUS,6HZAINT  ) 

CIOOO  CONTINUE 

C - 

C  Enable  graphical  display  device  w/out  spooling)  e.g.  CONTRL  •  0. 
C - 


CONTRL  -  0 

CALL  ZDINT  (GOUTLU, CONTRL, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  9999 
CALL  ERRNS  (ALPHLU, STATUS, 6HZDINT  ) 

9999  CONTINUE 

C - 

C  Return  to  nain  progran  after  all  devices  are  properly  enabled 

C - 

RETURN 

END 

C 

c 

C  SUBROUTINE  VIEUT 

C 

C  PURPOSE:  This  subroutine  perforns  the  initial  viewing 


transfornotion. 


017?  C 
0180  C 

1181  C  DESCRIPTION!  Thi«  subroutine  psrforns  the  viewing  transfornation  in 
0182  C  the  following  steps! 

0183  C 

1184  C  -  Places  the  inage  on  the  largest  possible  area 

018S  C  -  Sets  the  window  to  the  desired  range. 

0186  C  -  Resets  the  viewport  to  leave  roon  for  labels 

0187  C  -  Reconputes  charocter  size  based  on  specified  window 

0188  C 

018?  C  CALLING  SEQUENCE:  CALL  UIEUT 
0190  C 

0191  C  PARAHETERSi  NONE 

0192  C 

0194  C 

0195  SUBROUTINE  U1EUT<8TATUS,WXHIN,WXHAX,UYHIN»WYMAX> 

0196  C 

0197  INTEGER  IDUH,  lERR 

0198  REAL  AR(2),UIEU<4),X8IZE,Y8IZE,XCSIZ,YCSIZ 

0199  REAL  UXHIN,UXHAX,UYHIN,UYHAX,HINX>HAXX,N1NY,HAXY 

0200  C 

0201  C  lOUH  -  Dunny  var 

0202  C  lERR  -  Error  return  <not  used) 

0203  C  AR  -  Holds  aspect  ratio 

0204  C  VIEW  -  Holds  currant  viewport  bounds 

0205  C  XSIZE  -  Tenp  work  variable 

0206  C  YSIZE  -  Tonp  work  variable 

0207  C  XCSIZ  -  Tenp  holder  of  choracter  size  X 

0208  C  XCSIZ  -  Tenp  holder  of  charocter  size  Y 

0209  C  WXNIN  -  Tenp  holder  of  window  X  -  nin 

0210  C  UXMAX  -  Tenp  holder  of  window  X  -  nox 

0211  C  UYNIN  -  Tenp  holder  of  window  Y  -  nin 

0212  C  UYMAX  -  Tenp  holder  of  window  Y  -  nox 

0213  C  tIINX  -  Tenp  holder  of  new  viewport  X  -  nin 

0214  C  HAXX  -  Tenp  holder  of  new  viewport  X  -  nox 

0215  C  NINY  -  Tenp  holder  of  new  viewport  Y  -  nin 

0216  C  NAXY  -  Tenp  holder  of  new  viewport  Y  -  nox 

0217  C 


0218 
0219  C 

0220  C  Inquire  aspect  ratio  of  logicol  display  linits 

0721  C - 

0222  CALL  ZIU8  <2S4,0,2,IOUN,AR,IERR> 

0223  IF  (lERR  .EQ.  0)  GO  TO  SSS 

0224  CALL  ERRNS  < 1 , lERR ,6HZIWS  > 

0225  CO  TO  9999 

0226  C - 

0227  C  Make  the  largest  possible  areo  of  the  logical  disploy  ovailable 
0228  C  for  graphical  output  by  setting  the  aspect  ratio(AR). 

0229  C - 


0230  SSS  YSIZE  -  AR(2) 

0231  XSIZE  -  1.0 

0232  CALL  ZASPK  (XSIZE, YSIZE) 

0233  C - 

0234  C  Specify  the  desired  range  of  X  and  Y  values  of  the  window 

0235  C - 

0236  CALL  ZUIND  (UXMIN, UXMAX, UYMIN, UYMAX) 

0237  C - 

0238  C  Inquire  current  viewport  linits 


0239  - - 

0240  CALL  ZIW8  (451 , 0 >4, IDUH,VIEU, lERR > 

0241  IF  (lERR  .EQ.  0)  GO  TO  577 

0242  CALL  ERRHS  (1,IERR>6HZIUS  ) 

0243  GO  TO  9999 

0244  - - 

0245  C  Calculatt  the  lower  left  hond  corner  of  The  viewport  and  leove 
0246  C  enough  rooM  for  labels.  The  viewport  is  reduced  12Z  on  each  side 
0247  C  to  give  roon  for  lables.  Set  the  new  viewport 

0248  - - 

0249  577  HINX  -  .12  «  VIEU(2) 

0250  MAXX  >  .88  «  VIEU<2) 

0251  HINT  -  .12  *  (/1EU(4> 

0252  HAXY  -  .88  «  V1EU<4> 

0253  CALL  ZVIEW  (MI NX, MAXX, HINT, HAXY) 

0254  C - 

0255  C  Now  set  the  character  site  bosed  on  the  size  of  the  window 
0256  C  The  constants  below  produce  a  readable  character  size  in  the  new 
0257  C  window. 

0258  C - 

0259  XC81Z  -  .015  «  (UXHAX  -  UXHIN) 

0260  YCSIZ  -  .025  «  (UYMAX  -  UYMIN) 

0261  CALL  ZC81Z  (XC8IZ,YC8IZ) 

0262  C 

0263  9999  RETURN 

0264  END 

0265  C************************************************************************* 

0266  C  SUBROUTINE  DRUDT 

0267  C 

0268  C  PURPOSE!  This  subroutine  draws  the  currant  graph. 

0269  C 

0270  C  DESCRIPTION:  This  subroutine  doors  the  alphonuneric  ond  grophics 
0271  C  disploys.  It  then  drows  the  current  groph.  Note 

0272  C  thot  if  the  user  hos  not  changed  any  doto  volues 

0273  C  the  dcfoult  valves  will  be  used. 

0274  C 

0275  C  CALLING  SEQUENCE!  CALL  DRUDT 
0276  C 

0277  C  PARAMETERS!  NONE 
0278  C 

0279  C«««»«*««**«*«««»««««««««*«*«*f*«******«*«**«*«*««*«***»«*««*««*****««»«*« 

0280  C 

0281  SUBROUTINE  DRUOT(XHIN,XHAX,YMIN,YMAX,DAT, lAEND) 

0282  REAL  DAT (3, 520) 

0283  DIMENSION  ILIST(3) ,RLIST(2) 

0284  INTEGER  TEXT ( 12) , OPCODE, RSIZE 

0285  C 

0286  REAL  UIEW(4) 

0287  C 

0288  C  V/IEU  -  Tenp  holder  of  viewport  bounds 
0289  C 

0290  C************************************************************************* 

0291  C 

0292  C  Clear  the  graphics  and  alphanuncric  displays 

0293  C - 

0294  CALL  ZNEUF 

0295  CALL  CLEAR 

0296  C - 

0297  C  Detcrnine  paraneters  for  LAXES  call.  Search  thru  data  for  YMAX . 

0298  C - 


0299  C - - - 

0300  XTIC  «  <XMAX-XHIN)/10.0 

0301  YTIC  »  <YHAX-YMIN)  /  10.0 

(7  <02  XORG  »  XMIN 

a3J3  YORG  »  YHIN 

0304  X.'IJU  »  l.O 

030S  YflJC  =  1.0 

0306  TSl/E  =  .02 

0307  CALL  LAXbS(Xf 1C, YTIC, XORG, YORG, XHJC,YMJC,TSIZE) 

0308  C - 

0309  C  Plot  th«  graph. 

0310  C - 

0311  CALL  ZMQUE(0AT(1,1),DAT(2,1)) 

0312  DO  5000  1=2,  lAEND 

0313  CALL  ZDRAU(DAT(1,1),DAT<2,I)) 

0314  5000  CONTINUE 

0315  C - 

0316  C  Changt  tht  viewport  to  the  naxinun  posiblc  so  text  strings  nay  bs 

0317  C  placed  anywhere  on  the  view  surface.  Output  the  text  strings,  then 

0318  C  reset  the  viewport. 

0319  C - - — — 

0320  6000  CALL  VPMAX  <V1EU) 

0321  TEXKl)  -  2HRe 

0322  TEXT<2)  -  2Hla 

0323  TEXT<3)  «  2Htl 

0324  TEXT(4>  «  2Hve 

0325  TEXT<5)  «  2H  P 

0326  TEXT<6)  »  2Hos 

0327  TEXT<7)  ■  2Hit 

0328  TEXT<8)  •  2Hio 

0329  TEXT<9)  »  2Hn 

0330  TEXT(IO)  -  2H(n 

0331  TEXT(il)  »  2Hn) 

0332  TEXT<12)  =  6412B 

0333  NMTEXT  =  24 

0334  XTEXT  »  XMIN  ♦  <XMAX  -  XHIN)  *  ,3 

0335  YTEXT  «  YMIN  ♦  < YMAX-YMIN)/21 . 0 

0336  C 

0337  CALL  ZMOVE  < XTEXT , YTEXT) 

0338  C  OPCODE«1052 

0339  C  ISIZE-1 

0340  C  RSlZE-0 

0341  C  ILIST(1)=6 

0342  C  CALL  ZOESCIOPCODE, ISIZE,RSIZE, ILIST,RLIST, lERR ) 

0343  C  IF  <IERR  .EQ.  0)  GO  TO  6010 

0344  C  CALL  ERRMS  < 1 , lERR ,6HZ0ESC  ) 

0345  6010  CALL  ZTEXT  (NMTEXT , TEXT) 

0346  C 

0347  C  CALL  ZIESC(3a50 ,3,0,ILIST,RLIST,IERR) 

0348  C  IF  (lERR  .EQ.  0)  GO  TO  6020 

0349  C  CALL  ERRMS  ( 1 , lERR ,6HZIESC  ) 

0350  C  GO  TO  9999 

0351  6020  TEXTd)  «  2HAt 

0352  TEXT(2)  »  2Hte 

0353  TEXT<3)  «  2Hnu 

0354  TEXT<4)  =  2Hat 

0355  TEXT<5)  =  2Hio 

0356  TEXT<6)  =  2Hn 

0357  TEXT<7)  =  2H<d 

0358  TEXT(B)  »  2Hb ) 


035f 

0360 

0361 

0362 

0363 

0364 

036S 

0366 

0367 

0368 

0369 

0370 

0371 

0372 

0373 

0374 

0375 

0376 

0377 

0378 

0379 

0380 

0381 

0382 

0383 

0384 

0385 

0386 

0387 

0388 

0389 

0390 

0391 

0392 

0393 

0394 

0395 

0396 

0397 

0398 

0399 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0407 

0408 

0409 

1410 

0411 

0412 

0413 

0414 

0415 

0416 

0417 

0418 


TEXT<9)  «  6412B 
NHTEXT  -  18 

XTEXT  -  XHIN  ♦  (XHAX  -XHIN)/30.0 
YTEXT  -  YHIN  ♦  <YH4X-YHIN)  *  .3 
OPCODE  -  250 
RLIST(l)  -  0 
RLIST<2)  -  1. 

ISIZE  •  0 
RSIZE  •  2 

CALL  ZMOVEC XTEXT, YTEXT) 

CALL  ZOESC<  OPCODE , ISIZE , RSIZE , ILIST , RLIST , lERR ) 

IF  <IERR  .EQ.  0)  CO  TO  6030 
CALL  ERRHS  (1,IERR,6HZ0ESC  > 

CO  TO  9999 

6030  CALL  ZTEXT<NMTEXT,TEXT) 

OPCODE-250 
RLISTd)  -  1. 

RLIST(2)  -  0 
ISIZE  •  0 
RSIZE  •  2 

CALL  ZOESC(OPCODE, ISIZE, RSIZE, ILIST, RLIST, lERR) 

IF  (lERR  .EQ.  0)  CO  TO  6040 
CALL  ERRHS  <1 , lERR ,6HZ0ESC  ) 

GO  TO  9999 
C 

6040  CALL  ZUIEU  < VIEW( 1 ) ,VIEU<2) , VIEU(3 > , VIEU(4> > 

CALL  ZHCUR 
C 

9999  RETURN 
END 

C  i 

C  SUBROUTINE  ERRHS 

C 

C  PURPOSE)  To  write  out  an  error  nessaqe . 

C 

C  DESCRIPTION)  This  subroutine  writes  an  error  nessage  to  the  alphanuneric 
C  LU.  The  error  nunber  and  DCL  subroutine  nane  thot  the  error 

C  occured  during  is  reported. 

C 

C  CALLING  SEQUENCE)  CALL  ERRHStALPHLU , ERROR ,SUBR ) 

C 

C  PARAHETERS) 

C  ALPHLU)  t INTEGER];  The  alphanuneric  LU 

C 

C  ERROR)  C INTEGER];  The  error  nunber  of  the  error  to 

C  reported 

C 

C  SUBR)  [INTEGER];  An  orray  containing  the  nane  of 

C  the  subroutine  where  the  error  occured 

C 

C 

SUBROUTINE  ERRHS  t ALPHLU, ERROR , SUBR > 

INTEGER  ALPHLU, ERROR,SUBR (3) 

C 

C  Write  out  the  error  nessage 
C 

CALL  ZHCUR 

WRITE(ALPHLU,100}  ERROR,  SUBR 
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0419 

0420 

0421 

0422 

0423 

0424 

0425 

0426 

0427 

0428 

0429 

0430 

0431 

0432 

0433 

0434 

0435 

0436 

0437 

0438 

0439 

0440 

0441 

0442 

0443 

0444 

0445 

0446 

0447 

0448 

0449 

0450 

0451 

0452 

0453 

0454 

045H 

0456 

0457 

0458 

0459 

0460 

0461 

0462 

0463 

0464 

0465 

0466 

0467 

0468 

0469 

0470 

0471 

0472 

0473 

0474 

0475 

0476 

0477 

0478 


100  FORMATC  Error  ”,I2>*  occurcd  in  subroutint  ",3A2) 


RETURN 

END 


C 

c 
c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE  I 
DESCRIPTION! 


SUBROUTINE  CLEAR 

To  clear  th«  alphanunoric  display 


This  subroutine  will  clear  the  alphanuneric  display 
oP  a  HP  2647  or  HP  2648  terninal.  If  the  display  is 
not  a  HP  2647  or  HP  2648  then  the  call  has  no  effect. 


CALLING  SEQUENCE!  CALL  CLEAR 
PARAMETERS!  NONE 


C****tt*M*t****1(**t***tM**t*******t**f***t*t*4ttt*f**W**f***Mn******* 

c 

SUBROUTINE  CLEAR 

INTEGER  ILIST(7),  STRINC(2>»  lERR 
REAL  DUMMY 


C 

C 

c 

c 

c 

c 


ILIST  -  Infornation  list  returned  by  ZIHS 
lERR  -  Error  infornation  returned  by  ZIUS  (not  used  here) 
DUMMY  -  Real  infornation  returned  by  ZIUS  (none  in  this  case) 
STRING  -  Device-dependent  connands  that  clear  a  264X  terninal 


DATA  STRING  /155S0B, 

/  \ 

33B  *  ISOB 

esc  h 

(hone  cursor) 


155128/ 

/  \ 

33B  *  112B 

esc  J 

(clear  display) 


c 

Inquire  the  status  of  the  alphanuneric  device! 
upon  return,  ILIST(4)  ■  -1  »■>  no  alpha  device, 

•  0  »>  it  is  disabled, 

*  1  ■*>  it  is  enabled. 

If  it  is  not  enabled,  just  return. 


CALL  ZIUS  (7050, 7,0, ILIST, DUMMY, lERR) 
IF  (lERR  .EQ.  0)  GO  TO  7070 
CALL  ERRMS  ( 1 , lERR ,6HZIUS  ) 

GO  TO  9999 

7070  IF  (ILIST(4)  .NE.  1)  GOTO  9999 


C  Alpha  device  is  enabled.  Moke  sure  it  is  '264X'  type  then  cleor. 

C 

IF  (ILIST(l)  .NE.  2H26)  GOTO  9999 

IF  ((ILIST(2)  .NE.  2H47)  .AND.  (ILIST(2)  .NE.  2H48))  GOTO  9999 
CALL  ZALPH  (4, STRING) 

C 

9999  RETURN 
END 
C 

C 
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SUBROUTINE  VPMAX 


0479  C 
0480  C 

0481  C  PURPOSEi  Set  the  viewport  to  the  naxinun  liwits. 

0482  C 

0483  C  DESCRIPTION!  The  current  viewport  is  saved  in  VIEW.  The  viewport 
0484  C  is  then  set  to  the  naxinun  linits. 

0485  C 

I486  C  CALLING  SEQUENCE)  CALL  UPHAX  <UIEU) 

0487  C 

0488  C  PARAHETERSi 

1489  C  VIEW)  [REAL  ARRAY  OF  4](  This  array  contains  the 

0490  C  viewport  before  it  wos 

0491  C  naxunized. 

0492  C 

0494  C 

0495  SUBROUTINE  VPMAX  (VIEW) 

0496  REAL  VIEW(4) 

0497  C 

0498  INTEGER  IDUM 

0499  REAL  AR(2>,  NEUX,  NEUY 

0500  C 

0501  C  IDUM  -  Dunny  work  variable 

0502  C  AR  -  Tenp  holder  of  the  aspect  ratio 

0503  C  NEWX  -  Tenp  work  varioble 

0504  C  NEUY  ~  Tenp  work  variable 

0505  C 

0506  Ct«t««»t«««««««««»«««««««««***«««»«**««****««*«««*««**««********«******«** 

0507  C 

0508  C  Inquire  current  viewport  and  save  it  in  array  VIEW 
0509  C 

0510  CALL  ZIUS  (451 ,0,4, IDUM, VIEW, lERR) 

0511  IF  (lERR  .EQ.  0)  CO  TO  8080 

0512  CALL  ERRMS  ( 1 , lERR ,6HZIWS  > 

0513  CO  TO  9999 

0514  C 

1515  C  Inquire  the  naxinun  aspect  ratio 
0516  C 

0517  8080  CALL  ZIWS  (254, 0 , 2, IDUM,AR , lERR > 

0518  C 

0519  C  Set  viewport  to  naxinun  dinensions 
0520  C 

0521  NEUY  -  1. 

0522  NEUX  -  1. 

0523  IF  (AR(2)  .LE.  1.)  NEUY  •  AR(2> 

0524  IF  (AR(2)  .CT.  1.)  NEWX  *  l./AR(2) 

0525  CALL  ZVIEU  (0 . 0, NEUX, 0 .0, NEUY) 

0526  C 

0527  9999  RETURN 

0528  END 

0529  END* 
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0001 
0002 
0003 
0004 
OOOS 
0006 
0007 
0008 
0007 
0010 
0011 
0012 
0013 
0014 
OOlS 
0016 
0017 
0018 
0019 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0032 
0033 
0034 
0035 
0036 
0  037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
0057 
0058 


FTN4,L 

C 
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SEGMENT t  UR13T 

+♦♦+♦++♦♦+♦♦♦+•«•♦♦♦♦♦♦♦++♦♦++♦♦+♦♦+♦++♦♦ 

FOR:  Walter  Read  Arny  Institute  ef  Research 
Departnent  of  Microwave  Research 
Walter  Reed  Arny  Medical  Center 
Washington,  DC  20112 

» 

BY:  Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744  i 

Phone:  (301)  292-2592 


*  Segnent  UR13T  is  the  segnent  ef  WR15  that  plots  a  * 

*  graph  on  the  terninal.  It  is  read  in  and  controi  passed  B 

«  to  it  by  on  EXEC<8,WR13T>  call  fron  segnent  WRi3C  after  « 

*  o  scan  is  finished.  WR13T  then  disploys  a  graph  on  the  B 

B  CRT  of  the  attenuotion  versus  position  of  the  scon.  B 

B  When  this  segnent  finishes,  this  groph  is  still  disployed  B 
B  while  the  next  scon  is  done  and  is  net  erosed  until  Just  B 
B  before  the  next  graph  is  plotted.  The  lost  groph  is  B 

B  disployed  while  the  antennoe  are  repositioned  ond  then  B 

B  WR13C  turns  the  graphic  display  off  without  erasing  it.  B 
B  The  user  can  reenoble  the  disploy  by  pressing  the  "SHIFT*  B 
B  and  *G  CURSOR*  keys.  When  this  segnent  is  finished,  it  B 
B  calls  EXEC(8,WR13C>  to  read  in  WR13C  and  poss  control  to  B 
Bit.  B 

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB 

PROGRAM  WR13T,5 

DIMENSION  DAT<3,520),IPRNM(4),INAHE(3>,IDCB(144> ,NAMEF(3) , 

B  ISIZE(2),ITITL(40) 

INTEGER  STATUS,  ALPHLU,  GOUTLU,  CRT,  PRNT 

COMMON  DAT , IPRNM , INANE , CRT , IPRNL , MESS , ICOOE , PRESAZ , ASTEPS , RFREQ , 
B  I AENO , TEMP 1 , TEMPS, IRNUM , RSTEPS , IREND , PRESRO , I DCB , NAMEF , 

B  ISIZE , IDONE , IPENO, ISEND , POSITN , IPFLAG , ILFLAG , ID , IDRCT , 

B  PLUNIT,ITITL,PRNT,ICRLOC 

EQUIVALENCE  < GOUTLU ,CRT > , ( ALPHLU , CR T> 

STATUS  -  Set  to  zero  if  no  errors  occur  in  a  called  routine 
ALPHLU  -  The  LU  of  the  olphonuneric  device 
GOUTLU  -  The  LU  of  the  graphics  output  device 


Z  Initialize  DGL  systen 

WR1TE(CRT,S20) 

0520  FORMAT<"") 

CALL  ZBEGN 
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0059  C  Enobl«  all  devices,  exit  if  any  errors 

0060  C - 

0061  CALL  ENDEV  <ALPHLU,COUTLU, STATUS) 

0062  IF  (STATUS  .NE.  0)  GOTO  9990 

0063  IF  (IPFLAC  .EG.  -1  >  CO  TO  6000 

0064  C - 

0065  C  Find  nininvn  and  nasinun  volues. 

0066  C - 

0067  XHIN  *  DAT(l,t) 

0068  XHAX  •  OATd.IAEND) 

0069  YMIN  -  100000. 

0070  YMAX  -  -YHIN 

0071  DO  5100  I«1,1AEND 

0072  IF  (0AT<2,I)  .GT.  YMAX)  YMAX  -  DAT(2,I) 

0073  IF  (DAT(2,I)  .LT.  YHIN)  YMIN  -  0AT(2>I) 

0074  5100  CONTINUE 

0075  IF  (ABS(YMIN)  ,NE.  YHIN)  CO  TO  5300 

0076  YHIN  -  INT  (YHIN) 

0077  GO  TO  5400 

0078  5300  YHIN  -  INT  (YHIN  >  .999) 

0079  5400  IF  (ABS(YMAX)  .NE.  YMAX)  CO  TO  5500 

0080  YHAX  -  INT  (YHAX  *  .999) 

0081  CO  TO  5600 

0082  5500  YMAX  ■  INT  (YHAX) 

0083  5600  IF  ((YMAX-YHIN)  .LT.  6.)  YHAX  «  YMIN  •••  6. 

0084  IF  (ABS(XHIN)  .NE.  XHIN)  CO  TO  5700 

0085  XHIN  -  INT  (XHIN) 

0086  GO  TO  5800 

0087  5700  XHIN  •  INT  (XHIN  -  .999) 

0088  5800  IF  (AB8(XHAX)  .NE.  XHAX)  CO  TO  5900 

0089  XHAX  «  INT  (XHAX  *  .999) 

0090  GO  TO  5950 

0091  5900  XHAX  >  INT  (XHAX) 

0092  C - 

0093  C  Perforn  the  viewing  transf ornatien,  exit  if  any  errors 

0094  C - 

0095  5950  CALL  VIEWT  (STATU8,XHIN,XHAX, YHIN, YHAX) 

0096  IF  (STATUS  .NE.  0)  GOTO  9990 

0097  C - 

0098  C  Draw  axis  and  label,  then  plot. 

0099  C - 

0100  CALL  DRUOT( XHIN, XHAX, YHIN, YHAX, DAT, lAEND) 

0101  CO  TO  9000 

1102  C - 

0103  C  Disable  logical  devices 

0104  C - 

0105  C6000  CALL  ZNEUF 

0106  C  CALL  CLEAR 

0107  6000  CALL  ZAEND 

0108  CALL  ZDEND 

0109  CALL  ZEND 

0110  C - 

0111  C  Call  EXEC  to  overlay  this  segnent  with  WR13C  ond  execute  it. 

0112  C - 

0113  9000  1NAHE(3)  >  2HC 

0114  CALL  EXEC  (ICODE,  INAHE) 

oils  9990  CONTINUE 
0116  C 

0117  CALL  ZAEND 

0118  CALL  ZDEND 


0119 

0120 

0121 

0122 

0123 

0124 

012S 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

013S 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

014S 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


C  Disable  DCL.  systtn 


CALL  ZENO 


C  Tarninata  progran 


9998  UR1TE(CRT,9999> 

9999  FORMAT! "■> 

END 


C  ENOEV  SUBROUTINE 

C 

C  PURPOSE!  This  subrsutins  anablts  all  logical  dovicts  us«d  by 

C  the  progran. 

C 

C  DESCRIPTION!  This  subroutine  enables  the  DCL  work  station.  The  DCL 
C  workstation  contains  alphanuneric  and  graphics  output 

C  devices. 

C 

C  CALLING  SEQUENCE!  CALL  ENDEV(ALPHLU,COUTLU, STATUS) 

C 

C  PARAMETERS! 

C  ALPHLU:  I INTEGER  I }  Alphanuneric  LU 

C  GOUTLU!  IlNTECERn  Graphics  output  LU 

C  STATUS!  1 INTEGER! >  Set  to  zero  if  no  errors  occur 

C  during  initiolizotion  of  the 

C  workstotion.  It  is  set  to  the 

C  DGL  error  return  value  if  an 

C  error  is  found. 

C 

c 

SUBR OUT I NE  ENDEV ( ALPHLU , GOUTLU , STATUS  > 

C 

INTEGER  ALPHLU,  GOUTLU,  STATUS 
INTEGER  CONTRL 

- - 

C  If  an  error  occurs,  write  out  an  error  nessage,  and  return. 

C 

C  Enable  alphanuneric  device 

- - 

CALL  ZAINT  (ALPHLU, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  1000 

CALL  ERRMS  (ALPHLU, STATUS, 6HZAINT  ) 

1000  CONTINUE 

- - 

C  Enoble  graphical  display  device  w/out  spooling)  e.g.  CONTRL  ■  0. 

- - 

CONTRL  >  0 

CALL  ZDINT  (GOUTLU, CONTRL, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  9999 
CALL  ERRMS  (ALPHLU, STATUS, 6HZD1NT  ) 

9999  CONTINUE 

- - 

C  Return  to  nain  progran  after  all  devices  are  properly  enabled 

C - - - 

RETURN 

END 


0179  C 
0181  C 

0182  C  SUBROUTINE  UIEWT 

0183  C 

0184  C  PURPOSE!  This  •ubroutin*  ptrforns  the  initial  vitwing 

018S  C  transf ornation . 

0186  C 

0187  C  DESCRIPTION!  This  subroutine  ptrforns  the  uitwing  tronsf ornation  in 

0188  C  the  following  sttps! 

0189  C 

0190  C  *  Places  the  inage  on  the  largest  possible  area 

0191  C  -  Sets  the  window  to  the  desired  range. 

0192  C  -  Resets  the  viewport  to  leave  roon  for  labels 

0193  C  -  Reconputes  character  size  based  on  specified  window 

0194  C 

0195  C  CALLING  SEQUENCE!  CALL  VIEUT 
0196  C 

0197  C  PARAHETERS!  NONE 

0198  C 

0199  C«*«««*««*«t«««»«««««»««««*««***««*<»***»*««**********«*«****B************ 

0200  C 

0201  SUBROUTINE  UIEUT(STATUS>UXHIN»WXHAX,UYMIN»WYHAX> 

0202  C 

0203  INTEGER  IDUM,  lERR 

0204  REAL  AR<2) >U1EU<4) ,XSIZE,YSIZE,XCSIZ,YC8IZ 

0205  REAL  WXMIN,MXHAX,WYHIN,WYHAX,HINX,HAXX,HINY,HAXY 

0206  C 


0207 

C 

IDUH 

- 

Dunny 

var 

0208 

C 

lERR 

- 

Errer 

return 

<not  used) 

0209 

c 

AR 

- 

Holds  aspect 

ratio 

0210 

c 

VIEW 

- 

Holds 

i  current  ' 

viewport  bounds 

0211 

c 

XSIZE 

- 

Tenp 

work  variable 

0212 

c 

YSIZE 

- 

Tenp 

work  varioblc 

0213 

c 

XCSIZ 

- 

Tenp 

holder 

of 

charocter  size 

X 

0214 

c 

XCSIZ 

- 

Tenp 

holder 

of 

choracter  size 

Y 

0215 

c 

WXNIN 

- 

Tenp 

holder 

of 

window  X  -  nin 

0216 

c 

UXMAX 

- 

Tenp 

holder 

of 

window  X  -  nax 

0217 

c 

WYMIN 

- 

Tenp 

holder 

of 

window  Y  -  nin 

0218 

c 

UYMAX 

- 

Tenp 

holder 

of 

window  Y  -  nax 

0219 

c 

MINX 

- 

Tenp 

holder 

of 

new  viewport  X 

- 

nin 

0220 

c 

MAXX 

- 

Tenp 

holder 

of 

new  viewport  X 

- 

nax 

0221 

c 

MIMY 

- 

Tenp 

holder 

of 

new  viewport  Y 

- 

nin 

0222 

c 

MAXY 

- 

Tenp 

holder 

of 

new  viewport  Y 

— 

nax 

0223  C 

0224  C««»««*«*««««*«««««««««»«««*««f««**«*«*««««*«*«*«*«********«*****«**«**«** 

0225  C 

0226  C  Inquire  aspect  ratio  of  logical  display  Units 

0227  - - 

0228  CALL  ZIU8  (254,0,2,IDUH,AR,IERR> 

0229  IF  (lERR  .EQ.  0)  GO  TO  555 

0230  CALL  ERRHS  ( 1 , lERR ,6HZIU8  ) 

0231  GO  TO  9999 

0232  C - 

0233  C  Make  the  largest  possible  area  of  the  logical  display  available 
0234  C  for  graphical  output  by  setting  the  aspect  ratio(AR). 

0235  C - 

0236  555  YSIZE  -  AR(2) 

0237  XSIZE  »  1.0 

0238  CALL  ZASPK  ( XSIZE , YSIZE) 


0239  C - 

0240  C  Specify  the  desired  ranqe  of  X  and  Y  volves  of  the  window 

0241  C - 

0242  CALL  ZUIND  <UXniN«UXHAX,yYHIN,UYHAX> 

0243  C - 

0244  C  Inquire  current  viewport  linits 

024S  C - 

0246  CALL  ZIU8  (4Sl,0,4»IOUn,VIEU,lERR) 

0247  IF  <IERR  .EQ.  0)  60  TO  577 

0248  CALL  ERRH8  ( 1 , lERR ,6HZIV8  > 

0249  GO  TO  9999 

0250  C - 

0251  C  Colcvlate  the  lower  left  hand  corner  of  the  viewport  and  leave 
0252  C  enough  roon  for  labels.  The  viewport  is  reduced  12Z  on  each  side 
0253  C  to  give  roon  for  lables.  Set  the  new  viewport 

0254  C - 

0255  577  HINX  •  . 12  «  VIEU<2> 

0256  HAXX  -  .88  »  9IEU<2) 

0257  HINT  -  .12  «  91Ey(4> 

0258  MAXY  >  .88  «  VlEy<4> 

0259  CALL  ZVlEy  <HINX,MAXX,niNY,HAXY> 

0260  C - 

0261  C  Now  set  the  character  size  based  on  the  size  of  the  window 
0262  C  The  constants  below  produce  a  readoble  character  size  in  the  new 
0263  C  window. 

0264  C - 

0265  XC81Z  •  .015  «  (dXHAX  •  yXHlN) 

0266  YC8IZ  •  .025  «  (dYHAX  •  yYNIN) 

0267  CALL  ZCSIZ  (XC81Z, YCSIZ) 

APAA  r* 

0269  9999  RETURN 

0270  END 

0272  C  SUBROUTINE  DRUOT 

0273  C 

0274  C  PURPOSE)  This  subroutine  draws  the  current  graph. 

0275  C 

0276  C  DESCRIPTION)  This  subroutine  clears  the  alphanumeric  and  graphics 
0277  C  displays.  It  then  draws  the  current  graph.  Note 

0278  C  that  if  the  user  has  not  changed  any  dota  values 

0279  C  the  default  values  will  be  used. 

0280  C 

0281  C  CALLING  SEQUENCE)  CALL  DRUOT 
0282  C 

0283  C  PARAHETER8)  NONE 
0284  C 

0286  C 

0287  SUBROUTINE  DRyDT(XHIN,XHAX,YNlN,YHAX,DAT,IAEND) 

0288  REAL  OAT (3, 520) 

0289  DIMENSION  ILIST(3) 

0290  INTEGER  TEXT< 12) , OPCODE .RSIZE 

0291  C 

0292  REAL  VIEy<4) 

0293  C 

0294  C  UIEy  -  Ttnp  holder  of  viewport  bounds 
0295  C 

0297  C 

0298  C  Clear  the  graphics  and  alphanuneric  displays 


-114- 


<.%  •.<« 


r*  au.' 


0299 

0300 

0301 

0302 

0303 

0304 

030S 

0306 

0307 

0308 

0309 

0310 

0311 

0312 

0313 

0314 

0315 

0316 

0317 

0318 

0319 

0320 

0321 

0322 

0323 

0324 

0325 

0326 

0327 

0328 

0329 

0330 

0331 

0332 

0333 

0334 

0335 

0336 

0337 

0338 

0339 

0340 

0341 

0342 

0343 

0344 

0345 

0346 

0347 

0348 

0349 

0350 

0351 

0352 

0353 

0354 

0355 

0356 

0357 

0358 


CALL  ZNEUF 
CALL  CLEAR 


C  Dctcrnint  parantttrs  for  LAXE8  call. 

C - 


Search  thrw  data  for  YHAX. 


XTIC  ■  <XHAX-XMIN>/10.0 

YTIC  ■  <YMAX-YHIN)  /  10.0 

XORG  •  XHIN 

YORC  •  YMIN 

XHJC  *1.0 

YMJC  -  1.0 

TSIZE  -  .02 

CALL  L AXES ( XT I C , YTIC , X0R6 , YORC , XHJC , YH JC , TSI ZE ) 
Plot  tho  graph. 


CALL  ZH09E(DAT(1,1),DAT(2>1>> 
DO  5000  I-2,IAEND 
CALL  ZDRAU<DAT(1,I)>DAT(2,I>) 
5000  CONTINUE 


C  Change  the  viewport  to  the  naxinun  posible  eo  text  string*  nay  be 
C  plnced  anywhere  on  the  view  surface.  Output  the  text  strings,  then 
C  reset  the  viewport. 


CALL  UPHAX  <VIEU) 


TEXTd) 

TEXT<2) 

TEXT<3) 

TEXT <4 ) 

TEXT<5) 

TEXT<6) 

TEXT<7) 

TEXT<8) 

TtXT<9) 

TEXTdO) 

TEXTdl) 

TEXT <12) 

NHTEXT  - 


2HRs 
2Hla 
2Hti 
2Hve 
2H  P 
2Hos 
2Hit 
2Hio 
2Hn 

-  2H<n 
•  2Hn) 

-  6412B 
24 


XTEXT  -  0.0 

YTEXT  -  YHIN  ♦  <YHAX-YHIN>/21 . 0 

CALL  ZHOVE  (XTEXT, YTEXT) 

OPCODE-1 052 
I8IZE-1 
R8IZE-0 
ILISTd)-6 

CALL  Z0E8C(0PC0DE,I8IZE,RSIZE,IL18T,RLI8T,IERR) 
IP  (lERR  .EQ.  0)  CO  TO  6010 
CALL  ERRHS  < 1 , lERR ,6HZ0E8C  ) 

CALL  ZTEXT  (NHTEXT, TEXT) 

CALL  ZIESC(30SO,3,0,ILI8T,RLIST,1ERR) 

IF  (lERR  .EQ.  0)  GO  TO  6020 
CALL  ERRHS  ( 1 , lERR ,6HZIE8C  ) 

CO  TO  9999 
TEXTd)  -  2HAt 
TEXr<2)  -  2Hte 


-  U5- 


I 

I 

fit 


I 

i 


K;5 


•V/' 
'  V 

I 


I 

p 

L'A 

I 


0359 

0360 

0361 

0362 

0363 

0364 

0365 

0366 

0367 

0368 

0369 

0370 

0371 

0372 

0373 

0374 

0375 

0376 

0377 

0378 

0379 

0380 

0381 

0382 

0383 

0384 

0385 

0386 

0387 

0388 

0389 

0390 

0391 

0392 

0393 

0394 

0395 

0396 

0397 

0398 

0399 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0407 

0408 

0409 

0410 

•  411 

0412 

0413 

0414 

0415 

0416 

0417 

0418 


TEXT<3)  ■  2Hnu 
TEXT<4)  •  2Hat 
TEXT<5)  «  2H1« 

TEXT<6>  *  2Hn 
TEXT(7)  ■  2H<d 
TEXT(8)  «  2Hb) 

TEXT(9)  •  6412B 
NHTEXT  -  18 

XTEXT  -  XHIN  *  (XHAX  -XHIN)/30.0 

YTEXT  «  YHIN  *  ( YHAX-YNlN)/2. 0 

OPCODE  ■  1050 

ILlSTll)  -  1 

ISIZE  -  1 

R8IZE  -  0 

CALL  ZHOUE( XTEXT, YTEXT) 

CALL  ZOESCIOPCOOE, ISIZE, R8IZE, ILI8T,RL1ST, lERR > 
IF  (lERR  .EQ.  0)  CO  TO  6030 
CALL  ERRHS  < 1 , lERR ,6HZ0ESC  > 

GO  TO  9999 

CALL  ZTEXT< NHTEXT, TEXT) 

OPCODE-1 050 
ILIST(l)  -  0 
18IZE  -  1 
RSIZE  -  0 

CALL  Z0E8C(0PC0DE, ISIZE, RSIZE, ILIST,RLI8T,IERR) 
IF  <1ERR  .EQ.  0)  GO  TQ  6040 
CALL  ERRHS  ( 1 , lERR ,6HZ0C8C  ) 

GO  TO  9999 

CALL  ZVIEU  (VIEW<1),9IEU(2),VIEU(3),VIEW<4)) 
CALL  ZHCUR 

RETURN 

END 


SUBROUTINE  ERRHS 


PURPOSE) 


T«  write  out  an 


PARAHETERS) 


DESCRIPTION)  This  subroutin*  write*  an  error  nessage  to  the  alphanoneric 
LU.  The  error  nunber  and  DGL  subroutine  nane  that  the  error 
occured  during  is  reported. 

CALLING  SEQUENCE)  CALL  ERRHSCALPHLU, ERROR, SUBR) 


ALPHLU)  {INTEGER))  The  alphanuneric  LU 

ERROR)  [INTEGER))  The  error  nunber  of  the  error  to 

reported 

SUBR)  (INTEGER))  An  array  containing  the  nane  of 

the  subroutine  where  the  error  occured 


SUBROUTINE  ERRHS  ( ALPHLU, ERROR, SUBR ) 
INTEGER  ALPHLU, ERROR, SUBR<3) 


0419  C  Uritc  out  the  error  nessaoe 
0420  C 

0421  CALL  ZMCUR 

0422  URITE<ALPHLU,100)  ERROR,  SUBR 

0423  100  FORHAK"  Error  •,I2,*  occured  in  subroutine  •  ,2AZ) 

0424  C 

1425  RETURN 

0426  END 

0427  C 

0428  C««««»*«««««««»««««*««»«««t*«*««*«*«*«****»*««*«**««*«**«««**««*««*«***»«* 

0429  C  SUBROUTINE  CLEAR 

0430  C 

0431  C  PURPOSE:  To  cleor  the  alphanumeric  display 

0432  C 

0433  C  DESCRIPTION:  This  subroutine  will  cleor  the  olphanuneric  display 
0434  C  of  o  HP  2647  or  HP  2648  terminol .  If  the  display  is 

0435  C  not  o  HP  2647  or  HP  2648  then  the  call  hos  no  effect. 

0436  C 

0437  C  CALLING  SEQUENCE:  CALL  CLEAR 
0438  C 

0439  C  PARAMETERS:  NONE 

0440  C 

0442  C 

0443  SUBROUTINE  CLEAR 

0444  INTEGER  ILIST(7),  STRINC<2),  lERR 

0445  REAL  DUMMY 

0446  C 

0447  C  ILIST  -  Information  list  returned  by  ZIHS 

0448  C  lERR  -  Error  information  returned  by  ZIUS  (not  used  hero) 

0449  C  DUMMY  -  Reol  information  returned  by  ZIUS  (none  in  this  case)  ^ 

0450  C  STRING  -  Device-dependent  commands  that  clear  a  264X  terminal 


0451 

0452 

C 

DATA  STRING  /15550B, 

15512B/ 

0453 

c 

/  \ 

/  \ 

0454 

c 

33B  150B 

33B  *  112B 

0455 

c 

esc  h 

esc  J 

0456 

c 

(home  cursor) 

(clear  disploy) 

0457 

c 

0458  C************************************************************************* 

0459  C 

0460  C  Inquire  the  status  of  the  olphanumeric  device: 

0461  C  upon  return,  ILIST<4)  ■  -I  “»>  no  alpha  device, 

0462  C  ■  0  ■*>  it  is  disobled, 

0463  C  •*  1  *■>  it  is  enabled. 

0464  C  If  it  is  not  enabled.  Just  return. 

0465  C 

0466  CALL  ZIUS  (7050, 7,0, ILIST, DUMMY, lERR) 

0467  IF  (lERR  .EQ.  0)  CO  TO  7070 

0468  CALL  ERRMS  ( 1 , lERR ,6HZIUS  > 

0469  CO  TO  9999 

0470  7070  IF  (1LIST(4)  .NE.  1)  CQTO  9999 

0471  C 

0472  C  Alpha  device  is  enobled.  Make  sure  it  is  '264X'  type  then  clear. 

0473  C 

0474  IF  (ILlST(i)  .NE.  2H26)  GOTO  9999 

0475  IF  ((ILIST(2)  .NE.  2H47)  .AND.  (ILIST(2)  .NE.  2H48))  GOTO  9999 

0476  CALL  ZALPH  (4, STRING) 

0477  C 

0478  9999  RETURN 
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0479 
0480 
0481 
0482 
0483 
0484 
048S 
0486 
0487 
0488 
0489 
0490 
0491 
0492 
0493 
0494 
0495 
496 
0497 
0498 
0499 
0500 
0501 
1502 
0503 
0504 
0505 
0506 
0507 
r/508 
]509 
0510 
0511 
0512 
0513 
0514 
0515 
0516 
0517 
0518 
•  519 
0520 
0521 
0522 
0523 
0524 
0525 
0526 
0527 
0528 
0529 
0530 
0531 
0532 
0533 


END 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE! 


SUBROUTINE  VPHAX 

Set  the  viewpert  to  the  naxinun  Unit*. 


DESCRIPTION!  The  current  uieupurt  ie  saved  in  VIEW.  The  viewport 
is  then  set  to  the  noxinun  linits. 

CALLING  SEQUENCE!  CALL  VPMAX  <VIEW> 

PARAMETERS! 

UIEU!  IREAL  ARRAY  OF  41)  This  array  contains  the 

viewpert  before  it  was 
naxunized . 


C 

C 


c 
c 
c 
c 
c 
c 

«*««$*«»$««$$«»««»«««»*»»$»»«»•««$«««««»»»* 

c 

C  Inquire  current  viewport  and  save  it  in  army  VIEW 
C 

CALL  ZIUS  (451,0, 4, IDUM, VIEW, lERR) 

IF  (lERR  .EQ.  0)  CO  TO  8080 
CALL  ERRHS  < 1 , lERR ,6HZIUS  > 

CO  TO  9999 

Inquire  the  naxinun  aspect  ratio 


SUBROUTINE  VPMAX  (VIEW) 

REAL  VIEW(4) 

INTECER  lOUH 

REAL  AR(2),  NEWX,  NEUY 

IDUN  -  Ounny  work  variable 

AR  -  Tenp  holder  of  the  aspect  ratio 

NEWX  -  Tenp  work  vorioble 

NEUY  -  Tenp  work  voriable 


C 
C 
C 

8080  CALL  ZIUS  (254 , 0 ,2 , IDUM , AR , lERR ) 

C 

C  Set  viewport  to  naxinun  dinensions 
C 

NEUY  -  1. 

NEWX  >  1. 

IF  (AR(2)  .LE.  i.)  NEUY  «  AR(2) 

IF  (AR(2)  .CT.  1.)  NEWX  -  l./AR(2> 
CALL  ZVIEW  (0,0, NEWX, 0.0, NEUY) 

C 

9999  RETURN 
END 
ENDS 
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ly 

1 

’S 

}? 

I 

> 

i?: 

IV 


0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 

0043 

0044 

0045 

0046 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 

0057 

0058 


FTH4, 

C  ««««««»««»«««««««««»«««$«««*»»«»»*««$»««$««»«»$«»»«»»«»«««««« 

c  « 

C  «  PROGRAHt  WR14 

C  * 

C  6  ♦++♦+++♦•♦■■♦•■♦•♦•*■♦♦++♦+++++♦+++++♦♦+♦♦+++♦♦ 

C  *  FOR  I  Walter  Read  Arny  Institute  of  Research 

C  «  Departnent  of  Hicrowavc  Research 

C  *  Walter  Reed  Arny  Hedical  Center 

C  *  Washington,  DC  20112 

C  « 

C  «  ♦♦♦♦♦♦♦♦♦♦♦♦♦•♦•♦♦♦+++++++++++++++++++++ 

C  « 

C  *  BY:  Technology  USA,  Inc. 

C  «  P.O.  Box  55333 

C  •  Fort  Washington,  Maryland  20744 

C  »  Phone t  (301)  292-2592 

C  « 

C  t  - 

C  «  Progran  WRt4  Is  designed  to  read  a  file  of  attenuation 

C  t  readings  created  by  progran  WR13,  WR15,  WR16,  or  WR17. 

C  *  It  lists  the  readings  on  the  printer  and  plots  then  on 

C  «  the  CRT  or  plotter  ond  writes  then  out  to  tape. 

C  « 

C  B************************************************************ 

PROGRAM  WR14 

DIMENSION  DAT<3,520),NAMEF(3>,NAMES(3> ,IDCB(144) ,IDATIM(1S) , 

«  ITITL<40),IFAT<3120>,IVNAN(5>,FAT<1560>,TYPEF(2> 

INTEGER  ALPHLU , GOUTLU, CRT , PRNT , TAPE 
LOGICAL  UP 

EQUIVALENCE  (DAT, IFAT) , <ALPHLU,CRT) , (DAT,FAT> 

DATA  CRT , GOUTLU , PRNT , TAPE/1 ,1,6,8/, 

*  PRINT, PLCRT,PLPLT,8TAPE/4*4HYE8  /,I1/15446B/, 

»  NF/0/,TYPEF/4HTAPE,4HDISC/ 

Clear  screen  and  print  heading. 

IWAIT  «  0 

CALL  CHCKl  (CRT,  TAPE,  IWAIT,  0,  1> 

IF  (IWAIT  .EQ.  0)  CO  TO  10 
STAPE  «  4HN0 
CALL  LPSTS  (PRNT,  UP) 

IF  (UP  .EQ.  .TRUE.)  CO  TO  10 
PRINT  -  4HN0 
10  URITE(CRT,1S) 

015  FORMATC", 

»  10X,55»«»,/, 

*10X, "*-,20X, -PROGRAM  WR14- ,20X , ’»- ,/, 

•10X,-*-,7X,-READ,  LIST,  AND  STORE  A  DISC  SCAN  FILE" ,8X , -*- ,/, 
*10X,5S'«M 

WRITE  (CRT, 29)  PRINT, PLCRT, STAPE, NAMEF 
029  FORMAT  (IX, ‘TOGGLE  SWITCH  OPTIONS" , 14X , "PRESENT  VALUES-,/, 

*-  1  -  List  data  on  printer . -,1A4,/, 

0"  2  -  Plot  data  on  the  CRT . ",1A4,//, 

•  -  4  -  Store  data  on  tape . . . ...-,1A4,/, 

»1X, "ACTION  OPTIONS-,/, 

*■  5  -  Enter  file  nane  .  . .  .  . -,342,/, 

*-  6  -  List  files  and  specs  on  CRT.. . ",/, 


i 

t' 


I 

0^*’ 

51 

fV 

V 


0059 
0060 
0061 
0062 
0063 
0  064 
0065 
0066 
0067 
0068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0  087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 


*' 

*■ 

»• 


7  -  List  tap€  fll«  p«r  switchts  1  &  2.*,/| 

8  -  Extcutt  toggle  switch  options . 

9  -  Terninats . . . . . ■*/>“*> 

610  URITE<CRT,619) 

0619  FORMAT  <"") 

C  CALL  CHCKl  (CRT,  TAPE,  0,  0,  1) 

620  URITE  (CRT,  629) 

629  FORMAT  (/, IX, “SELECT  AN  OPTION  NUMBER.  _") 


READ  (CRT,*)  IANS 
IF  (IANS  .£Q.  9999)  GO  TO  9990 
9)  GO  TO  9990 
8) 

7) 

6) 

5) 

4) 

3) 

2) 

1) 


(IANS 
(IANS 
(IANS 
(IANS 
(IANS 
(IANS 
(IANS 
(IANS 
(IANS 
URITE  (CRT, 659) 

659  FORMAT  (/, IX, “ERROR  *  WR14  - 
«  “INCORRECT  RESPONSE. 

GO  TO  610 


IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 

IF 


.EQ. 

.Eq. 

-EQ. 

.EQ. 

.EQ. 

.EQ. 

.EQ. 

.EQ. 

.EQ. 


GO  TO  8000 
GO  TO  7000 
GO  TO  6000 
GO  TO  5000 
GO  TO  4000 
GO  TO  3000 
GO  TO  2000 
GO  TO  1000 


16001  . (UR14)“,/,IX, 

ENTER  ANY  DIGIT  EXCEPT  0. 


C  Toggle  the  “PRINT“  switch. 

C - 

1000  IF  (PRINT  .EQ.  4HYES  )  GO  TO  1100 
PRINT  -  4HYES 

C  CALL  LP8TS  (PRNT,  UP) 

C  IF  (UP  .EQ.  .TRUE.)  GO  TO  1400 
C  WRITE  (CRT,  1009) 

C1009  FORMAT  (/,1X,"ERR0E  ♦  WR14  -  16004 
C  *  "PRINTER  IS  NOT  UP“> 

C  GO  TO  620 

GO  TO  1400 
1100  PRINT  >  4HNO 
1400  WRITE  (CRT,  1409)  II,  PRINT 
1409  FORMAT  (1A2,  “a  41c  5Y“,1A4) 

GO  TO  610 


(WR14)“,/,1X, 


C  Toggle  the  “plot  on  CRT“  switch. 

C - 

2000  IF  (PLCRT  .EQ.  4HYES  )  GO  TO  2100 
PLCRT  -  4HYE3 
GO  TO  2400 
2100  PLCRT  »  4HNO 
2400  WRITE  (CRT,  2409)  II,  PLCRT 
2409  FORMAT  (lA2,“a  41c  6Y“,1A4) 

GO  TO  610 


C  Toggle  the  “plot  on  plottcr“  switch. 


0112  3000  IF  (PLPLT  .EQ.  4HYES  )  GO  TO  ilOO 

0113  PLPLT  =»  4HYES 

0114  GO  TO  3400 

0115  3100  PLPLT  »  4HNO 

0116  3400  WRITE  (CRT,  3409)  II,  PLPLT 

0117  3409  FORMAT  (lA2,“a  41c  7Y“,1A4) 

0118  GO  TO  610 


0119 
0120 
0121 
0122 
0123 
0124 
0125 
0126 
0127 
0128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
•  161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 


C  Toggle  the  "store  data  on  tape"  switch. 


4000  IF  (STARE  .EQ.  4HYES  >  GO  TO  4100 
lUAlT  «  1 

CALL  CHCKl  (CRT,  TAPE,  IWAIT,  0, 
STARE  -  4HYES 
GO  TO  4400 
4100  STARE  -  4HN0 
4400  URITE  (CRT,  4409)  II,  STARE 
4409  FORMAT  (lA2,"a  41c  8Y‘,1A4) 

GO  TO  610 


Enter  file  nane . 


5000  URITE  (CRT, 5009) 

5009  FORMAT  (/,iX, "Enter  file  nane. 

READ  (CRT, 5019)  NAMEF 
5019  FORMAT  (3A2) 

IF  ((NAMEF(l)  ,EQ.  2H99)  .AND. 
5300  URITE  (CRT,  5309)  II,  NAMEF 
5309  FORMAT  (lA2,-a  41c  10Y",3A2) 
GO  TO  610 


(NAMEF(2)  .EQ.  2H99))  CO  TO  9998 


C  List  files  and  specifications  on  the  CRT. 

C - 

6000  URITE  (CRT, 6009) 

6009  FORMAT  (""."FILE  TIME  DATE  ASTERS  ", 

«  "VA  ♦OA  ySTEPS  RFREQ  tFR  FSTEP",/, 

«  - -  -  . 


NAMES(l)  •>  2HSC 
NAMES(2)  =  2HS1 

6010  NAMES(3)  <*  2Hlf 
DO  6200  I  >  1,31 
IF  (IFBRK(IERR))  10,6020 

6020  NAMES(3)  >  NAMCS(3)  +  1 

CALL  OPEN  (IDCB,  lERR,  NAMES) 

IF  (lERR  .EQ.  -6)  GO  TO  6200 

IF  (lERR  .GE.  0)  GO  TO  6050 

CALL  ERRMS  (ALPHLU,  lERR,  6H0REN  ) 

GO  TO  620 

6050  CALL  READF  (IDCB,  lERR,  IFAT,  3120) 

IF  (lERR  .EQ.  0)  GO  TO  6100 

CALL  ERRMS  (ALPHLU,  lERR,  6HREADF  ) 

GO  TO  620 

6100  URITE  (CRT, 6109)  NAMES,  (IFAT(J),  J-1,4),  (IFAT(J),  J-9,12), 

*  IFAT(15),  IFAT(5B),  FAT(30),  1FAT(56),  IFAT(62), 

*  (FAT(J),  J-32,33),  IFAT(70),  FAT(36), 

*  (IFAT(J),  J-16,54> 

6109  FORMAT  (3A2, IX ,4A2, 1X,5A2,2X, 13, 1X,F6 . 2 ,2X, 1A2,2X , 13, 1X,F6 . 2, 

*  2X,F5.0,2X,I3,2X,F5.0,/,39A2) 

6200  CONTINUE 

IF  (NAMES(2)  .HE.  2HS1 )  GO  TO  6250 
NAMES(2)  >  NAMES(2)  *  1 
GO  TO  6010 

6250  IF  (NAMES(l)  .NE.  2HSC)  CO  TO  6300 
NAMES(l)  -  2HSR 
GO  TO  6010 

6300  URITE  (CRT,  6309) 


-1^1- 


I 

I 


0179  6309  FORMAT  (iX^-THAT  18  ALL  THE  FILES.  PRESS  'RETURN'  WHEN  READY.') 

0180  READ  (CRT,*)  IANS 

0181  GO  TO  10 

•  182  C - 

0183  C  List  taps  fils  psr  switchss  162. 

018A  C - 

0185  -^OOO  IF  (NF  ,NE.  0)  GO  TO  7100 
0186  WRITE  (CRT,  7009) 

0187  7009  FORMAT  (/,  IX, 'ERROR  •  UR14  -  16002  . (URi4)  ■,/,lX, 

0188  «  'THERE  ARE  NO  TAPE  FILES  TO  LIST.”) 

0189  GO  TO  620 

0190  7100  WRITE  (CRT,  7109) 

0191  7109  FORMAT  (/,lX,"Entsr  0  for  last  fils  or  N  for  fils  ON.  ”) 

0192  READ  (CRT,*)  JANS 

0193  IF  (JANS  .EQ.  9999)  CO  TO  9998 

0194  IF  (JANS  .EQ.  0)  GO  TO  7500 

0195  IF  (JANS  .LE.  NF)  GO  TO  7200 

0196  WRITE  (CRT,  7119)  NF 

0197  7119  FORMAT  (/, IX, 'ERROR  *  WR14  -  16003  . (WR14) ■,/,lX, 

0198  *  'NO  SUCH  FILE  0.  ENTER  ANY  NUMBER  UP  TO  ”,12) 

0199  GO  TO  7100 

0200  7200  CALL  EXEC  (3,  410B) 

0201  IF  (JANS  .EQ.  1)  GO  TO  7700 

0202  DO  7300  I  >  1,  JANS-1 

0203  7300  CALL  EXEC  (3,  13108) 

0204  GO  TO  7700 

0205  7500  CALL  EXEC  (3,  1410B) 

0206  CALL  EXEC  (3,  1410B) 

0207  IF  (NF  .EQ.  1 )  GO  TO  7700 

0208  CALL  EXEC  (3,  1310B) 

0209  7700  ICODE  «  1 

0210  GO  TO  8090 

0211  C - 

0212  C  Rsad  and  writs  first  rscord  and  distribvts  data. 

0213  C - 

0214  8000  IF  (NAMEF(l)  .NE.  2H  )  GO  TO  8010 

0215  WRITE  (CRT, 8009) 

0216  8009  FORMAT  (/, IX, 'ERROR  *  WR14  -  16004  . (UR14)”, 

0217  *  /,1X,"N0  FILE  NAME  HAS  BEEN  ENTERED.') 

0218  GO  TO  620 

0219  8010  CALL  OPEN  ( IDCB, IERR,NAMEF) 

0220  IF  (lERR  .NE.  -6)  GO  TO  8020 

0221  WRITE  (CRT, 8019) 

0222  8019  FORMAT  (/, IX, 'ERROR  •  WR14  -  16005  . (WR14)*,/, 

0223  *  IX, 'THIS  FILE  NOT  FOUND  ON  DISC.',/, 

0224  *  IX, "TRY  A  DIFFERENT  FILE  NAME.") 

0225  GO  TO  620 

0226  8020  IF  ( lERR  .GE.  0)  GO  TO  8040 

0227  CALL  ERRMS  (ALPHLU,  lERR,  6H0PEN  ) 

0228  GO  TO  9998 

0229  8040  CALL  READF  (IDCB,  lERR,  IFAT,  3120,  LEN) 

0230  IF  (lERR  .EQ.  0)  GO  TO  8060 

0231  CALL  ERRMS  (ALPHLU,  lERR,  6HREADF  ) 

0232  GO  TO  620 

0233  8060  ICODE  «  2 

0234  IRECS  «  IFAT(68) 

0235  IF  (STAPE  .EQ.  4HNO  )  GO  TO  8100 

0236  DO  8080  1  -  1 ,  3 

0237  8080  IFAT(72+I)  ■  NAMEF(I) 

0238  8090  CALL  EXEC  (ICODE,  lOB,  IFAT,  IRECS) 


-  122- 


0239 

0240 

024i 

0242 

0243 

0244 

0245 

0246 

0247 

0248 

0249 

0250 

0251 

0252 

0253 

0254 

0255 

0256 

0257 

0258 

0259 

0260 

0261 

0262 

0263 

0264 

0265 

0266 

0267 

0268 

0269 

0270 

0271 

0272 

0273 

0274 

0275 

0276 

0277 

0278 

0279 

0280 

0281 

0282 

0283 

0284 

0285 

0286 

0287 

0288 

0289 

0290 

0291 

0292 

0293 

0294 

0295 

0296 

0297 

0298 


8100 

8109 


URITli  (CRT,  8109) 

FORMAT  <■") 

DO  8200  I  >  1,  15 
IDATIMd)  -  IFATd) 

DO  8300  I  >  1,  40 
ITITLd)  -  IFAT  <15*I) 

NOTAV  «  IFAT (56) 
lAEND  >  IFAT<58) 

ASTERS  >  FAT(30 
IVEND  «  1FAT(62) 

VSTEPS  ■  FAT (32) 

RFREQ  >  FAT (33) 

IF  (IANS  .NE.  7)  GO  TO  8370 
DO  8350  I  -  1,  3 
NAMEFd)  -  IFAT  (72+1) 

IF  (NOT AO  .EQ.  2HR0)  GO  TO  8400 
IFEND  -  IFAT(70) 

FSTEPS  >  FAT (36) 
lONAH(l)  -  2HEL 
IVNAM(2)  -  2HE9 
I9NAM(3)  -  2HAT 
IVNAM(4)  «  2HI0 
I0NAN(5)  -  2HN 
GO  TO  8450 
IFEND  >  1 


lONAHd) 

I9NAM(2) 

I9NAM(3) 

IUNAH(4) 

I9NAM(5) 


-  2HAN 

-  2HGL 
«  2HE 
«  2H 

«  2H 


:  Variable  loop  fron  1  to  IVEND  and  frequency  loop  fron  0  to  IFEND-i 

C - - - 

8450  PRESVA  >  0 

DO  8800  J-1, IVEND 

DO  8700  K  -  0,IFEND-1 

PRESFR  »  RFREQ  ♦  K  »  FSTEPS 

IF  (IANS  .EQ.  7)  GO  TO  8463 

CALL  READF  (IDCB,  lERR,  IFAT,  IRECS) 

IF  (lERR  .EQ.  0)  GO  TO  8460 

CALL  ERRHS  (ALPHLU,  lERR,  6HREADF  ) 

GO  TO  620 

8460  IF  (ST APE  .EQ.  4HN0  )  GO  TO  8465 
8463  CALL  EXECdCODE,  lOB,  IFAT,  IRECS) 

8465  IF  (PRINT  .EQ.  4HN0  )  CO  TO  8480 
PRESVA  >  DAT(1,  IAEND+1) 

WRITE  (PRNT,8469)  TYPEF(ICODE) ,NAHEF, IDATIM, ITITL, IVNAH, PRESVA , 

It  PRESFR 

8469  FORMAT  ( " 1 • , /, IX , 1A4, “  FILE  * ,3A2, IX, 15A2,// , IX ,40A2, // 

*  1X,SA2,’-",F8.3,"  FREQUENCY  -■,F6.0,//, 

«  IX, "AZIMUTH  ATTENUATION  PHASE",/, 

*  IX," -  -  - ") 

8480  IF  (PLCRT  ,EQ.  4HN0  )  GO  TO  8590 

YMIN  >  100000. 

YMAX  «  -YMIN 
XMIN  «  DAT(1,1) 

XMAX  -  DAT(1,IAEND) 

DO  8500  I-l,  lAEND 

IF  (DAT(2,I)  .GT,  YMAX)  YMAX  -  DAT(2,I) 

IF  (0AT(2,I)  .LT.  YMIN)  YMIN  -  DAT(2,I) 


-1.23- 


029?  8S0I  CONTINUE 
0300  CALL  ZBEGN 

0301  CALL  ENOEU  (ALPHLU>  COUTLU,  lERR) 

0302  IF  (lERR  .NE.  0)  GO  TO  620 

0303  C - 

0304  C  Ptrforn  th«  vicwinq  tronsforitatlan,  cult  if  any  «rrors 

0305  C - 

0306  IF  (ABS(YHIN)  .NE.  YHIN>  GO  TO  8510 

0307  YHIN  >  INT  (YHIN) 

0308  GO  TO  8520 

0309  8510  YHIN  -  INT  (YHIN  -  .999) 

0310  8520  IF  <AB3(YHAX)  .NE.  YHAX)  GO  TO  8530 

0311  YHAX  -  INT  <YHAX  ♦  .999) 

0312  GO  TO  8540 

0313  8530  YHAX  •  INT  (YHAX) 

0314  8540  IF  (<YHAX-YHIN)  .LT.  6.)  YHAX  -  YHIN  ♦  6. 

0315  IF  (ABS(XHIN)  .NE.  XHIN)  GO  TO  8550 

0316  XHIN  •  INT  (XHIN) 

0317  GO  TO  8560 

0318  8550  XHIN  -  INT  (XHIN  -  .999) 

0319  8560  IF  (ABS(XHAX)  .NE.  XHAX)  GO  TO  8570 

0320  XHAX  •  INT  (XHAX  +  .999) 

0321  GO  TO  8580 

0322  8570  XHAX  «  INT  (XHAX) 

0323  8580  CALL  VIEUT  ( lERR, XHIN, XHAX, YHIN, YHAX) 

0324  IF  (lERR  .NE.  0)  GOTO  620 

0325  C - 

0326  C  Draw  axis  ond  label,  th«n  plot. 

0327  C - 

0328  CALL  DRUOT  (XHIN,  XHAX,  YHIN,  YHAX,  DAT,  lAEND) 

0329  C - 

0330  C  Print  out  data  on  line  printer 

0331  C - 

0332  8590  IF  (PRINT  .Eq.  4HN0  )  GO  TO  8700 

0333  DO  8600  I  >  1,  lAEND 

0334  8600  WRITE  (PRNT,8609)  (DAT(II,I) ,11^1 ,3) 

0335  8609  FORHAT  (1X,F8.3,7X,F8.3,7X,F8.3> 

0336  8700  CONTINUE 

0337  8800  CONTINUE 

0338  C - 

0339  C  End  of  rotation  loop 

0340  C - 

0341  IF  (IANS  .EQ.  7)  GO  TO  8810 

0342  IF  (STAPE  .EO.  4HN0  )  GO  TO  8803 

0343  CALL  EXEC  (3,  HOB) 

0344  NF  «  NF  >  1 

0345  8803  CALL  RUNOF  (IDCB,IERR) 

0346  IF  (lERR  ,EQ,  0)  GO  TO  8900 

0347  CALL  ERRH8  (ALPHLU,  lERR,  6HRUNDF  > 

0348  GO  TO  620 

0349  8810  IF  (JANS  .NE.  0)  GO  TO  8850 

0350  CALL  EXEC  (3,  1310B) 

0351  GO  TO  8900 

0352  8850  DO  8860  I  -  1,  NF-JANS+l 

0353  8860  CALL  EXEC  (3,  1310B) 

0354  8900  WRITE  (CRT, 8909) 

0355  8909  FORHAT  ("  0356  GO  TO  10 

0357  C - 

0358  C  Tcrninatc  progran 

0359  C - 


0360 

0361 

0362 

0364 

0365 

0366 

0367 

0368 

0369 

0370 

0371 

0372 

0373 

0374 

0375 

0376 

0377 

0378 

0379 

0380 

0381 

0382 

0383 

0384 

0385 

0386 

0387 

0388 

0389 

0390 

0391 

0392 

0393 

0394 

0395 

0396 

0397 

0398 

1399 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0407 

0408 

0409 

0410 

0411 

0412 

0413 

0414 

0415 

0416 

0417 

0418 

0419 

0420 


9990  CONTINUE 
9998  yRlTE<CRT,9999) 

09999  FORHNK"  0363  WRITE  (CRT, 999) 

999  FORHRT  (/,10X, 

M’*9********  PROGRAM  UR14  TERMINATED 
CALL  CLOSE  (lOCB) 

END 

C 


ENDEU  SUBROUTINE 

PURPOSE!  This  subrautinc  snoblss  all  logical  dsvicts  assd  by 

ths  progran. 

DESCRIPTION!  This  subrautins  snablas  ths  D(U.  work  station.  Ths  DCL 
workstation  contains  alphanunsric  and  graphics  output 
dsuicss. 

CALLING  SEQUENCE!  CALL  ENDCU<ALPHLU,COUTLU, STATUS) 


PARAMETERS! 


ALPHLU!  ( INTEGER  1)  Alphanunsric  LU 

GOUTLUi  (INTEGER]}  Graphics  output  LU 

STATUS!  (INTEGER!;  Sst  to  zsro  if  no  srrors  occur 

during  initiolization  of  ths 
workstation.  It  is  sst  to  ths 
DCL  srror  rsturn  ualus  if  on 
srror  is  foond. 


SUBR  OUT I NE  ENDEU  <  ALPHLU , GOUTLU , STATUS ) 

C 

INTEGER  ALPHLU,  GOUTLU,  STATUS 
INTEGER  CONTRL 

C - 

C  If  on  srror  occurs,  writs  out  on  srror  nsssogs,  and  rsturn. 

C 

C  Enobls  alphonunsric  dsvics 

C - 

CALL  ZAINT  (ALPHLU, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  1000 

CALL  ERRMS  (ALPHLU, STATUS, 6HZAINT  ) 

1000  CONTINUE 

C - 

C  Enobls  graphical  display  dsvics  w/out  spooling;  s.g.  CONTRL  ■  0. 

C - 

CONTRL  -  0 

CALL  ZDINT  (GOUTLU, CONTRL, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  9999 
CALL  ERRMS  (ALPHLU, STATUS, 6HZDINT  ) 

9999  CONTINUE 

C - 

C  Rsturn  to  nain  progran  aftsr  all  dsuicss  ars  propsrly  snablsd 

C - 

RETURN 

END 

C 

coooasosstsssosskssssssssskssasossssssssssssssasssstssssssaassssspt, 
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ii 


I 


043t 

0422 

0423 

0424 

042S 

1 426 

0427 

0428 

0429 

0430 

0431 

0432 

0433 

0434 

043S 

0436 

0437 

0438 

0439 

0440 

0441 

0442 

0443 

0444 

0445 


0462 

0463 

0464 

0465 

0466 

0467 

0468 

0469 

0470 

0471 

0472 

0473 

0474 

0475 

0476 

0477 

0478 

0479 

0480 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c« 

c 


SUBROUTINE  VIEWT 


PURPOSE) 


This  subroutins  psrforns  the  initial  viswinf 
transf ornation . 


DESCRIPTION: 


This  subrstftina  perforns  th«  viawinQ  transfsrnation  in 
the  follouinp  stapst 


-  Places  the  inaqe  on  the  lorgeat  possible  ores 

-  Sets  the  uindoM  to  the  desired  range. 

-  Resets  the  viewport  to  leave  rooM  for  labels 

-  Reconputes  character  site  based  on  specified  window 


CALLING  SEQUENCE)  CALL  UIEUT 


PARAHETER8) 


NONE 


SUBROUTINE  UIEWT(STATU8,UXNIN, WXHAX, WYNIN,WYHAX> 


INTEGER  lOUH,  lERR 

REAL  AR<2) ,UIEU<4) ,XSIZE,YSIZE,XCSIZ, YCSIZ 
REAL  UXHIN,UXHAX,UYMIN,WYMAX,HINX,HAXX,NINY,HAXY 


0446 

C 

IbUH 

- 

Dunny 

1  var 

0447 

C 

lERR 

- 

Error 

'  return 

1  (not  used) 

0448 

C 

AR 

- 

Holds  aspect 

'  ratio 

0449 

C 

VIEU 

- 

Holds  current 

viewport  bounds 

0450 

C 

XSIZE 

- 

Tenp 

work  variable 

0451 

C 

YSIZE 

- 

Tenp 

work  variable 

0452 

C 

XCSIZ 

- 

Tenp 

holder 

of 

character  siie 

X 

0453 

C 

XCSIZ 

- 

Tenp 

holder 

of 

character  size 

Y 

0454 

c 

UXhIN 

- 

Tenp 

holder 

of 

window  X  -  nin 

0455 

c 

UXHAX 

- 

Tenp 

holder 

of 

window  X  -  nax 

0456 

c 

UYhIN 

- 

Tenp 

holder 

of 

window  Y  -  nin 

0457 

c 

UYMAX 

- 

Tenp 

holder 

of 

window  Y  -  nax 

0458 

c 

MINX 

- 

Tenp 

holder 

of 

new  viewport  X 

- 

nin 

0459 

c 

MAXX 

- 

Tenp 

holder 

of 

new  viewport  X 

- 

nax 

0460 

c 

MINY 

- 

Tenp 

holder 

of 

new  viewport  Y 

- 

nin 

0461 

c 

MAXY 

- 

Tenp 

holder 

of 

new  viewport  Y 

- 

nox 

C 

Cl 

c 

c 

c- 


Inquire  aspect  ratio  of  logical  display  linits 


CALL  ZIU8  <2S4,0,2,1DUM,AR,IERR) 
IF  (lERR  .EQ.  0)  CO  TO  555 
CALL  ERRH8  ( 1 , IERR,6HZ1W8  ) 

GO  TO  9999 


C- 

C 

C 

C- 


Make  the  largest  possible  orea  of  the  logical  display  available 
for  graphical  output  by  setting  the  ospect  ratio<AR). 


555  YSIZE  -  AR(2) 

XSIZE  -  1.0 

CALL  ZASPK  (XSIZE, YSIZE) 


Specify  the  desired  range  of  X  and  Y  values  of  the  window 


-  126- 


y 


jtTVT.V.  .^njsr.  jv^vTJvinr^-v  irv 


0481  CALL  ZWIND  < WXHIN,UXHAX>WYHIN,UYHAX> 

0482  C - 

0483  C  Inquira  current  viewport  Units 

0484  C - 

0485  CALL  ZIU8  <451 , 0 ,4, IDUM,UICU, lERR > 

0486  IF  (lERR  .EQ.  0)  CO  TO  577 

0487  CALL  ERRHS  ( 1 , lERR ,6HZ1U8  ) 

0488  GO  TO  9999 

0489  C - 

0490  C  Calculate  the  lower  left  hand  corner  of  the  viewport  and  leave 
0491  C  enouqh  roon  for  labels.  The  viewport  is  reduced  12X  on  each  side 
0492  C  to  give  roon  for  lables.  Set  the  new  viewport 

0493  C - 

0494  577  HINX  >  .12  «  VIEU<2) 

0495  MAXX  -  .88  *  <;iEU(2) 

0496  HZNY  -  . 12  «  V1EU<4) 

0497  MAXY  -  .88  «  <^IEU<4) 

0498  CALL  ZVIEU  < HINX, HAXX,HINY, MAXY) 

0499  C - 

0500  C  Now  set  the  character  site  based  on  the  site  of  the  window 
0501  C  The  constants  below  produce  a  readoble  character  size  in  the  new 
0502  C  window. 

0503  C - 

0504  XC81Z  -  .015  «  (UXHAX  -  UXHIN) 

0505  YCSIZ  -  .025  «  <UYHAX  -  UYHIN) 

0506  CALL  ZCSIZ  <XCSIZ, YCSIZ) 

0507  C 

0508  9999  RETURN 

0509  END 

0511  C  SUBROUTINE  DRUDT 

0512  C 

1513  C  PURPOSE)  This  subroutine  draws  the  current  graph. 

0514  C 

0515  C  DESCRIPTION:  This  subroutine  clears  the  alphonuneric  and  graphics 
0516  C  displays.  It  then  draws  the  current  graph.  Note 

0517  C  that  if  the  user  has  not  changed  any  data  values 

0518  C  the  default  volues  will  be  used. 

0519  C 

0520  C  CALLING  SEQUENCE)  CALL  DRHDT 
0521  C 

0522  C  PARAMETERS)  NONE  \ 

0523  C 

0524  C**«««««««««*««««««««««*«*9««*«*««««**«*«*»*******«*«**«***«*»««***«*»«*«« 

0525  C 

0526  SUBROUTINE  DRUDT<XMIN,XMAX, YMIN, YMAX,DAT , lAEND) 

0527  REAL  DAT (3,520) 

0528  DIMENSION  ILIST(3) 

0529  INTEGER  TEXT( 12) .OPCODE, RSIZE 

0530  C 

0531  REAL  VIEN(4) 

0532  C 

0533  C  VIEW  -  Tenp  holder  of  viewport  bounds 
0534  C 

0536  C 

0537  C  Cleor  the  graphics  and  alphanuneric  displays 

0538  C - 

0539  CALL  ZNEUF 

0540  CALL  CLEAR 


•541  C - 

0542  C  D«tarnin«  paranctars  far  LAKES  call. 

0543  C - 

0544  C - 

0545  XTIC  «  <XHAX-XM1N)/II.0 

0546  YTIC  -  <YMAX-YM1N)  /  10.0 

0547  XORC  -  XMIM 

0548  YORC  •  YMIN 

0549  XHJC  -  1.0 

05S0  YNJC  -  1.0 

0551  TSIZE  >  .02 

0552  CALL  LAXES<XTIC, YTXC,X0R6»Y0R6, XHJC, YHJC, TSIZE) 

0553  C - - - - - - - — - 

0554  C  Plot  tha  qraph. 

0555  - - 

0556  CALL  ZH0UE<0AT(1,1>,0AT(2,1>) 

0557  DO  5000  1-2,  lAEND 

0558  CALL  ZORAU< DAT( 1 , I ) ,DAT(2, I ) > 

0559  5000  CONTINUE 

0560  - - 

0561  C  Changa  tha  viawport  ta  tha  naxinun  poalbla  aa  taxt  atringa  nay  ba 
0562  C  placed  anywhora  on  tha  viaw  aurfaca.  Output  tha  taxt  atringa,  than 
0563  C  raaat  tha  viawport. 

0564  - - 

0565  6000  CALL  UPHAX  (UlEU) 

0566  Tf-XT(l)  -  2HRa 

0567  TEXT<2)  -  2Hla 

0560  TEXT<3)  -  2Hti 

0569  TEXT<4)  -  2Hva 

0570  TEXT<5)  -  2H  P 

0571  TEXT(6)  -  2Hoa 

0572  TEXT<7)  -  2Hit 

0573  TEXT<8)  •  2Hio 

0574  TEXT<9)  -  2Hn 

0575  TEXTdO)  »  2H<n 

0576  TEXT<il)  -  2Hn) 

0577  TEXT<12)  ■  6412B 

0570  NHTEXT  »  24 

0579  XTEXT  -  0.0 

0580  YTEXT  -  YHIN  ♦  < YMAX-YHIH)/21 . 0 

0581  C 

0582  CALL  ZHOVE  < XTEXT, YTEXT) 

0583  OPCODE-1 052 

0584  ISIZE-1 

0585  RSIZE-0 

0586  ILIST<l)-6 

0587  CALL  ZOESC<OPCODE,ISIZE,RSIZE, ILIST,RLIST, lERR > 

0588  IF  (lERR  .EQ.  0)  GO  TO  6010 

0589  CALL  ERRMS  < 1 , lERR ,6HZ0ESC  ) 

0590  6010  CALL  ZTEXT  (NHTEXT, TEXT) 

0591  C 

0592  C  CALL  ZIESC(3050,3,0,ILI8T,RLIST,IERR) 

0593  C  IF  (lERR  .EQ.  0)  GO  TO  6020 

0594  C  CALL  ERRHS  < 1 , lERR ,6HZIESC  ) 

0595  C  GO  TO  9999 

0596  6020  TEXTd)  -  2HAt 

0597  TEXT<2)  -  2Hta 

0590  TEXT<3)  -  2Hnu 

0599  TEXT(4)  -  2Hat 

0600  TtXT<5)  -  2Hio 
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0601 

0602 

0603 

0604 

0605 

0606 

0607 

0608 

0609 

0610 

0611 

0612 

0613 

0614 

0615 

0616 

0617 

0618 

0619 

0620 

0621 

0622 

0623 

0624 

0625 

0626 

0627 

0628 

0629 

0630 

0631 

0632 

0633 

0634 

0635 

0636 

0637 

0638 

0639 

0640 

0641 

0642 

0643 

0644 

0645 

0646 

0647 

0648 

0649 

0650 

0651 

0652 

0653 

0654 

0655 

0656 

0657 

0658 

0659 

0660 


TEXT(6>  >  2Hn 
TEXT<7)  -  2H<d 
TEXT(8)  -  2Hb) 

TEXT(9)  -  6412B 
NHTEXT  «  18 

XTEXT  -  XHIN  *  (XHAX  -XHIN>/30,0 

YTEXT  -  YHIH  ♦  (YHAX-YHIN)/2. 0 

OPCODE  -  1050 

ILISTd)  -  1 

ISIZE  >  1 

RSIZE  -  0 

CALL  ZHOVE< XTEXT, YTEXT) 

CALL  ZOESC(OPCODE, ISIZE, RSIZE, ILI8T,RLI8T,IERR> 

IF  (lERR  .EQ.  0)  CO  TO  6030 
CALL  ERRHS  < 1 , lERR ,6HZ0ESC  ) 

GO  TO  9999 

6030  CALL  ZTEXT<NHTEXT,TEXT) 

OPCODE-1 050 
ILZST<1)  -  0 
ISIZE  -  1 
RSIZE  -  0 

CALL  ZOESC<OPCODE, ISIZE, RSIZE, ILIST,RLIST,IERR> 

IF  (lERR  .EQ.  0)  GO  TO  6040 
CALL  ERRHS  < 1 , lERR ,6HZ0ESC  ) 

CO  TO  9999 
C 

6040  CALL  ZUIEV  ( VIEU< 1 ) ,0IEW<2) ,VIEU(3) ,VIEU(4> > 

CALL  ZMCUR 
C 

9999  RETURN 
END 

C  1 

C  SUBROUTINE  ERRHS 

C 

C  PURPOSE:  To  write  out  an  error  Message. 

C 

C  DESCRIPTION:  This  subroutine  writes  an  error  Message  to  the  alphanuMcric 
C  LU.  The  error  nunber  and  DCL  subroutine  nane  that  the  error 

C  tccured  during  is  reported. 

C 

C  CALLING  SEQUENCE:  CALL  ERRHSCALPHLU, ERROR, SUBR) 

C 

C  PARAHETERS: 

C  ALPHLU:  [INTEGER])  The  alphonuMeric  LU 

C 

C  ERROR:  (INTEGER];  The  error  nunber  of  the  error  to 

C  reported 

C 

C  SUBRi  (INTEGER];  An  array  contoining  the  nane  of 

C  the  subroutine  where  the  error  occured. 

C 

C 

SUBROUTINE  ERRHS  < ALPHLU, ERROR ,SUBR ) 

INTEGER  ALPHLU, ERR QR,SUBR( 3) 

C 

C  Write  out  the  error  Message 
C 

CALL  ZHCUR 
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066i 

0662 

0663 

0664 

0665 

0666 

0667 

0668 

0669 

0670 

0671 

0672 

0673 

0674 

0675 

0676 

0677 

0678 

0679 

0680 

0681 

0682 

0683 

0684 

0685 

0686 

0687 

0688 

0689 

0690 

0691 

0692 

0693 

0694 

0695 

0696 

0697 

0698 

0699 

0700 

0701 

0702 

0703 

0704 

0705 

0706 

0707 

0708 

0709 

0710 

0711 

0712 

0713 

0714 

0715 

0716 

0717 

0718 

0719 

0720 


URITE(4LPHLU,100)  ERROR,  SUBR 
100  FORMATC  Error  *,13,*  occurrod  in  subroutint  *,3A2> 

RETURN 

END 


C  SUBROUTINE  CLEAR 

C 

C  PURPOSE!  To  cloar  th«  alphanunoric  display 

C 

C  DESCRIPTION!  This  subroutin*  will  door  ths  alphanuMtric  display 
C  of  a  H7  2647  or  HP  2648  torninal .  If  ths  display  is 

C  not  o  HP  2647  or  HP  2648  than  ths  call  has  no  offset. 

C 

C  CALLING  SEQUENCE t  CALL  CLEAR 
C 

C  PARAMETERS!  NONE 

C 

C*9**fM***$*********$$*$W***t***$******$************t***W*********ft 

C 

SUBROUTINE  CLEAR 

INTEGER  ILIST<7),  STRING(2),  lERR 
REAL  DUMMY 
C 

C  ILIST  -  Infornation  list  rsturnsd  by  ZIUS 
C  lERR  -  Error  infornation  rsturnsd  by  ZIHS  (not  ussd  hsrs> 

C  DUMMY  -  Rsal  infornation  rsturnsd  by  ZIUS  (nons  in  this  cqss> 

C  STRING  -  Dsvics-dspsndsnt  connands  thot  clsor  a  264)(  tsrninol 


DATA  string  /15S50B, 

/  \ 

33B  *  ISOB 

ssc  h 

(hons  cursor) 


15512B/ 

/  \ 

33B  *  112B 

esc  J 

(clsor  disploy) 


c 

C  Inquire  Ths  status  of  ths  alphanunsric  device i 
C  upon  return,  ILIST(4)  »  -1  *■>  no  alpha  device, 

C  ■  0  «*>  it  is  disabled, 

C  ■  1  «■>  it  is,  enabled. 

C  If  it  is  not  enabled.  Just  return. 

C 

CALL  ZIUS  (7050, 7,0, ILIST, DUMMY, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  7070 
CALL  EKRMS  ( 1 , lERR ,6HZ1US  ) 

GO  TO  9999 

7070  IF  (ILIST(4)  . NE .  1)  GOTO  9999 
C 

C  Alpha  device  is  enabled.  Make  sure  it  is  '264X'  type  then  clear. 

C 

IF  (ILIST(l)  .NE.  2H26)  GOTO  9999 

IF  ((ILIST(2)  .NE.  2H47)  .AND.  (ILI3T(2)  .NE.  2H48))  GOTO  9999 
CALL  ZALPH  (4, STRING) 

C 

9999  RETURN 
END 
C 

cooeoteeeeeeeoeeeeeeeeeeeeeeeeseeeeeesteeeeeeeeeeeeeeeeeeeefeeeeeeeeyesbe;! 
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0721 
0722 
0723 
0724 
072S 
0726 
0727 
0728 
0727 
0730 
0731 
0732 
0733 
0734 
0735 
0736 
0737 
0738 
0739 
0740 
0741 
0742 
0743 
0744 
0745 
0746 
0747 
0748 
•  749 
0750 
0751 
0752 
0753 
0754 
0755 
0756 
0757 
0758 
0759 
0760 
0761 
0762 
0763 
0764 
0765 
0766 
0767 
0768 
0769 
0770 
0771 
0772 


C  SUBROUTINE  UP MAX 

C 

C  PURPOSE)  Set  the  viewport  to  the  noxinun  Unite. 

C 

C  DESCRIPTION:  The  current  viewport  ie  eoved  in  VIEW.  The  viewport 

C  is  then  set  to  the  nojiinun  linits. 

C 

C  CALLING  SEQUENCE)  CALL  VPMAX  (VIEW) 

C 

C  PARAMETERS : 

C  VIEW)  (REAL  ARRAY  OF  41 t  This  array  contains  the 

C  viewport  before  it  was 

C  naxunizsd. 


SUBROUTINE  VPMAX  (VIEW) 

REAL  VIEW(4) 

C 

INTEGER  IDUM 
REAL  AR(2),  NEWX,  NEWY 
C 

C  IDUM  -  Ounny  work  vorioble 

C  AR  -  Tenp  holder  of  the  aspect  ratio 

C  NEWX  -  Tenp  work  variable 

C  NEWY  -  Tenp  work  variable 

C 

c 

C  Inquire  current  viewport  and  save  it  in  array  VIEW 
C 

CALL  ZIWS  (451 ,0,4, IDUM, VIEW»IERR) 

IF  (lERR  .EQ.  0)  GO  TO  8080 
CALL  ERRHS  < 1 , lERR ,6HZIWS  ) 

GO  TO  9999 
C 

C  Inquire  the  naxinun  aspect  ratio 
C 

8080  CALL  ZIWS  (254 , 0 , 2 , IDUM, AR , lERR ) 

C 

C  Set  viewport  to  naxinun  dinensions 
C 

NEWY  -  1. 

NCUX  *  1 • 

IF  (AR(2)  .LE.  1.)  NEWY  ■  AR(2) 

IF  (AR(2)  .GT.  1.)  NEWX  *•  l./AR(2) 

CALL  ZVIEW  (0.0, NEWX, 0.0, NEWY) 

C 

9999  RETURN 
END 
END« 
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C  24998-18466  REV. 2040  <810304.1057) 

C 

C  PROGRAM  UR 15 

C 

C  DESCRIPTION! 

C  WR15  is  dssigntd  to  obtain  nicrowavo  transmission  data  at  diffsront 
C  points  along  a  rastor  scan  and  to  stors  ths  dota  in  a  disc  fils. 

C  This  program  has  boon  divided  into  four  segments  because  it  cannot 

C  fit  into  memory  otherwise.  The  moin  segment  always  remains  in 
C  memory.  Segment  URISC  is  the  control  segment,  which  is  the  first 

C  one  read  in  by  the  main  segment.  The  other  two  are  WR15G,  which 

C  plots  on  the  plotter  and  UR15T,  which  plots  on  the  terminol. 

C  UR15C  gives  the  user  a  choice  of  where  to  plot  for  each  run,  so 
C  essentially,  for  each  run  there  are  only  three  segments.  The 
C  two  segments  beside  the  moin  overlay  each  other  by  one  segment 
C  calling  EXEC<8,  other  segment  name)  to  read  in  the  other 
C  segment  over  the  calling  segment  and  then  pass  control  to  it. 

C  It  can  return  to  the  calling  segment  only  by  calling  EXEC(8, 

C  other  segment  name)  agoin. 

C  This  segment  is  the  main  segment.  It  is  run  by  typing  in: 

C  RU,UR15 

C  This  segment  only  defines  common,  initializes  variables,  and 
C  then  calls  EXEC(8,UR15C)  to  read  in  and  pass  control  to  segment 
C  UR15C. 

C 

C**********t*$tt**t*t*t*******$9$*$**M*$*t$*****$*nf******»**$$*ft$*$$$*$* 

c 

PROGRAM  URi5 
C 

DIMENSION  DAT<3,520),IPRNM(4),INAME(3) ,IDCB(i44> ,NAMEF(3) , 

*  ISIZe<2),ITITL(40),PLUNIT(2) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNM,INAME, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREQ, 

*  lAEND, TEMPI, TEMP2,IRNUM, ESTEPS, ICEND,PRESEL,IDCB,NAMEF, 

*  ISIZE , lOONE, IPEND, ISEND , POSITN , IPFLAG , ILFLAG , ID , IDRCT , 

*  PLUNIT, ITITL,PRNT,FSTEPS, IFEND, IGRLOC 
COMMON/AGSZC/  D<10) 

IRNUM  «  1 
CRT  -  1 

IPRNM<1)  «  IHU 
IPRNM<2)  «  IHR 
IPRNM<3)  =  IHi 
IPRNM<4)  =  IMS 
IPRNL  -  4 
MESS  ■  -1 
ASTEPS  ■  5 
lAEND  >  4 
ESTEPS  *  30 
lEEND  -  3 

IPEND  »  i 
ISEND  »  1 
I DONE  >  0 
PRESAZ  =  999.9 
IPFLAG  *  1 
ILFLAG  »  i 
PLUNITd)  »  4H  -  C 


I 
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0059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070  C- 
0071  C 
0072  C- 
f  0073  C 
0074 
0075 
0076 
0077 
0078 
0079 
0080  C 
0081  C 
0082  C 
0083 
0084 
0085 
0086 


PLUNIT<2)  •  4HRT 
ICRLOC  >  1 
IFEND  -  1 
NAHEFd)  -  2HSC 
NAM£F(2)  «  2HS2 
NAHEFO)  -  2Hi8 
PRNT  -  6 
CALL  FILE2(1) 

TEMPI  »  D<1) 

TtMP2  «  <D<3)  -  1)  *  D<2)  ♦  D(l) 
RFREQ  «  0(1) 


Call  EXEC  to  read  in  sognont  URISC  and  pose  control  to  it. 


IC00E>8 

INAME(1)-2HUR 

INAME(2)"2H15 

INAME<3)«2HC 

CALL  EXEC  (ICODE,  INAME) 

END 

Block  data  routine  for  AGS2C 

BLOCK  DATA  AGS2C 
COMMON  /AGS2C/  1(2330) 

END 

ENO« 
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*M**t*******t*f*****1f*******************************$****** 

SEGMENT:  UR15C 

♦++++++++++++++++++++-*-+++++++*+++++++++ 

FOR:  Walter  Reed  Arny  Institute  of  Research 

Departnent  of  Microwave  Research 
Walter  Reed  Arny  Medicol  Center 
Washington,  DC  20112 

++++++♦♦♦♦♦♦♦♦♦♦♦+++++++♦++++♦++♦++♦♦♦ 

BY:  Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone:  (301)  292-2592 


*  Segnent  WRi5C  is  the  control  segnent  of  WR15.  It  puts  * 

*  out  a  nenu  with  the  options:  * 

*  1  -  Enter  the  nunber  of  azinuth  steps  ond  step  size.  * 

*  2  -  Enter  the  nunber  of  elevation  steps  ond  step  size.  « 

*  3  -  Enter  the  nicrowave  frequency.  t 

*  4  -  Set  antennae  to  a  new  azinuth  position,  4 

4  5  -  Set  antennae  to  a  new  elevation  position.  $ 

4  6  -  Enter  nunber  of  readings  to  average  for  eoch  point.  4 

4  7  -  Request  graphs  on  the  CRT.  4 

4  10  -  List  on  the  printer.  4 

4  11  -  Enter  nunber  of  frequency  steps  ond  step  size.  4 

4  8  -  Scan  fron  the  present  position  4 

4  9  -  Terninate  the  progran,  4 

4  After  8  is  chosen,  the  antennae  are  positioned  at  the  4 

4  present  position-(nunber  of  data  po ints-1 >4step  sizc/2.  4 
4  The  anplitude  and  phase  are  each  averaged  over  the  nunber  4 
4  of  readings  specified  in  6  and  saved  in  the  arroy  DAT  4 

4  along  with  the  position.  Then  the  antennae  are  advanced  4 

4  by  step  size  and  the  anplitude  and  phase  are  read  agoin.  4 

4  This  is  repeated  for  the  specified  nunber  of  steps  per  4 

4  scan.  « 

4  After  each  scan,  the  data  accunuloted  in  array  DAT  is  4 

4  read  out  to  a  disc  file,  SCS12A.  If  there  is  a  file  4 

4  with  that  none  already,  the  last  letter  is  increnented.  4 

4  After  the  data  is  read  out,  elevotion  is  increnented  by  4 

4  elevation  step  size  and  the  whole  process  repeated  for  4 

4  the  nunber  of  elevation  steps.  * 

4  « 

**$$*$$$$$$*$$*t$*$$$$)r$$*$$$$$$t$i***$**$$**$$***$$**t$«****** 

PROGRAM  UR15C,5 

DIMENSION  DAT<3,520) ,IPRNM(4) ,INAME(3) ,IDCB(144) ,NAMEF(3) , 

4  ISIZE<2),ITITL<40),IREC(2),XFAT<3120),PRNTL<2), 

4  PLUNIT<2) ,FAT(1560) 

INTEGER  CRT.PRNT 

COMMON  DAT , IPRNM , INAME , CRT , IPRNL ,MESS , ICODE , PRESAZ , ASTEPS , RFREQ , 
4  lAEND, TEMPI, TEMP2,IRNUN, ESTEPS, iEEND,PRESEL,IDCB,NAMEF, 

4  ISIZE , IDONE , IPEND, ISEND , POSITN , IPFLAG , ILFLAG , ID , IDRCT  , 

4  PLUNI T , I TI TL ,PRNT ,FSTEPS , IFEND , IGRLOC 

EQUIVALENCE  (REG, IREG) , (DAT, IFAT) , (DAT,FAT) 
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00S9 
0060 
0061 
0062 
0063 
0064 
006S 
0066 
,  0067 
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;  ]  0069 

I  ]  0070 

‘  f  0071 

;  (  0072 

k  0073 

;  0074 

.  0075 

0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 

;  i  0093 

0094 
0095 
I  0096 
'  0097 

0098 
j  0099 

I  0100 
0101 

.  0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 
0111 
0112 
0113 
0114 
0115 
0116 
0117 
0118 


C 

C0nM0N/AGS2C/  D( 10 ) ,CAL(6, 112) ,F1 ,F2 ,F3 ,H1 ,H2,RP1 ,RP2 ,RP3 ,NONLY , 
»CH<4,112),1HEAD(40),IDATE<15> 

DATA  LUAZ/3 1 / , LUEL/35/ ,11/1 5446B/ 

C - 

C  Sat  nunber  of  scans  if  plots  rcqucsttd. 

C - 

C  If  start  of  progran,  go  to  nonu. 

IF  <PRESAZ  .EQ.  999.9)  GO  TO  525 
C  If  graphing  on  scrton,  do  not  list  data  thort. 

IF  <IGRLOC  .EQ.  1)  ILFLAG  -  0 
C  If  finishtd  with  run,  go  rosot  position. 

IF  <IDONE  .GE.  lEENO)  GO  TO  515 
C  If  platting  every  scan,  go  do  next  scan. 

IF  (IPENO  .EQ.  1)  GO  TO  8701 
IF  (IDONE  .NE.  1)  GO  TO  511 
IF  (IPEND  .GT.  lEEND)  GO  TO  513 
C  Plotted  first  scan  so  now  get  back  on  schedule. 

ISEND  ■  IPEND  -  1 
GO  TO  8701 

511  IF  < IDONE -vlPEND  .GT.  lEEND)  GO  TO  513 
C  Plot  every  specified  scan. 

ISEND  »  IPEND 
GO  TO  8701 

C  Scan  to  end  of  run  without  plotting. 

513  ISEND  =  lEEND  -  IDONE 
IPFLAG  »  -1 
GO  TO  8701 

C - 

C  Reset  original  position. 

C - 

515  WRITE  (CRT,  519) 

519  FORMAT  </,lX,-SCAN  IS  FINISHED" ,/, IX , 

t  "ANTENNAE  ARE  BEING  RESET  TO  THEIR  ORIGINAL  POSITION", 

*  /, IX, "PLEASE  EXCUSE  THE  DELAY") 

CALL  SETPO  (CRT,  LUAZ,  PRESAZ,  2,  lERR) 

IF  (lERR  .EQ.  0)  GO  TO  522 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

522  PRESEL  »  PRESEL  -  ESTEPSX IEEND-1 ) 

CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

IF  (lERR  .EQ.  0)  CO  TO  523 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

C  Reset  paraneters  to  original  values. 

523  IF  (IPFLAG  .EQ.  0)  CO  TO  525 
ISEND  >  1 
IPFLAG  a  1 
ILFLAG  a  1 
525  IDONE  a  0 

C - 

C  Clear  screen  and  print  heading  and  nenu. 

C - 

WRITE(CRT,529) 

0529  FORMAT("" 

*  10X,55'*»,/» 

*10X,  "fjZOX,  "PROGRAN  WRIS"  ,20X  , 

*10X, *»*,15X, "S21  RASTER  SCAN  PROGRAM" , 15X ,"**,/ , 
tl0X,55'*' ,/) 

530  CALL  URl  (CRT,  LUAZ,  PRESAZ,  lERR,  0) 
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IF  (lERR  .EQ.  0)  CO  TO  540 

CALL  UR12  <CRT>  lEfiR,  .TRUE.,  0,  0,  IPRNN,  IPRNL) 

GO  TO  9090 

540  CALL  URl  (CRT.LUEL ,PRESEL, lERR , 0 ) 

IF  (lERR  .EQ.  0)  GO  TO  550 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

CO  TO  9090 

550  IF  (PRNT  .EQ.  0)  CO  TO  555 
PRNTL(l)  -  4H  PRI 
PRMTL<2)  -  4HHT 
GO  TO  560 

555  PRNTL(l)  -  4HN0  P 
PRNTL(2)  -  4HRINT 

560  URITE(CRT,600)  IAEN0,A8TEP8, lEEND, ESTEPS, RFREq,PRESAZ,PRE8EL, 
*IRNUH,IPEND,(PLUNIT<I>,I-1,2>,(PRNTL(I>,I-1,2>,1FEND,FSTEPS 
0600  FORHATC  PROGRAM  PARAMETER  ENTRY', 30X, "PRESENT  VALUES',/, 

O'  1  -  Nunbtr  of  azinuth  steps  and  stop  size........*, 

*13,'  z',F6.2,'  ««',/, 

**  2  ~  Number  of  elevotion  steps  and  step  size . .*, 

*13,'  x',F6.2,'  mm',/, 

*'  3  -  Mlcrowove  frequency . . .  .  . . *, 

*F7.0,'  MHz-,/, 

*"  4  -  Azimuth  position . . . *, 

*F8.3,'  mm',/, 

**  5  '  Elevation  position . 

*F8.3,'  mm',/, 

*-  6  -  Number  of  readings  to  average  per  point . *,I5,/, 

*'  7  -  Number  of  scans  per  grapMs . . . ....*, IS, 1)(,2A4,/, 

*'  10  -  Toggle  switch  for  listing  on  printer . ",2X,2A4,/, 

*-  11  -  Number  of  frequency  steps  and  step  size . ', 

*13,"  k*,FS.0,'  MHz',/, 

*'  EXECUTION  OPTIONS',/, 

*'  8  -  Scan  from  the  present  position.',/, 

*'  9  -  Terminate  the  program.',/") 

610  WRITE  (CRT, 619) 

C  Clear  old  prompt  with  Esc  h  Esc  J. 

0619  FORMAT  <") 

620  WRITE  (CRT, 629) 

629  FORMAT  (IX, 'SELECT  OPTION  NUMBER  ") 

REAO(CRT,*)  IANS 
IF  (IANS  .EQ.  9999)  GO  TO  9090 
IF  (IANS  .EQ.  10)  GO  TO  700 
IF  (IANS  ,EQ.  11)  GO  TO  800 
IF  (IANS  .EQ.  9)  GO  TO  9090 

IF  (IANS  .EQ.  8)  GO  TO  8000 

IF  (IANS  .EQ.  7)  GO  TO  7000 

IF  (IANS  .EQ.  6)  GO  TO  6000 

IF  (IANS  .EQ.  5)  GO  TO  5000 

IF  (IANS  .EQ.  4)  CO  TO  4000 

IF  (IANS  .EQ.  3)  GO  TO  3000 

IF  (IANS  .EQ.  2)  GO  TO  2000 

IF  (IANS  .EQ.  1)  GO  TO  1000 

WRITE  (CRT, 659) 

659  FORMAT  (/, IX, "ERROR  «  WRIS  -  17001  . (HR IS) ' ,/ , IX , 

*  "INCORRECT  RESPONSE.  ENTER  ANY  NUMBER  FROM  1  TO  11.') 

GO  TO  620 

C - 

C  Set  to  print  on  printer. 

C - 

700  IF  (PRNT  .EQ.  6)  GO  TO  750 


0179 

0180 

0181 

0182 

0183 

0184 

0185 

0186 

0187 

0188 

0189 

0190 

0191 

0192 

0193 

0194 

0195 

0196 

0197 

0198 

0199 

0200 

0201 

0202 

0203 

0204 
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PRNT  «  6 
PRNTL(l)  > 
PRNTL(2)  > 
CO  TO  760 
PRNT  X  0 
PRNTL(l)  • 


4H  PR  I 
4HNT 


$ 

I 


PRNTL(l)  >  4HN0  P 
PRNTL(2)  -  4HRINT 

760  WRITE  <CHT,769)  II , <PRNTL< I ) ,1-1 ,2) 
769  F0RH6T  <1A2,  "o  54c  13Y-,2A4> 

CO  TO  610 


Inquire  froM  usert  frequency  step  size  and  nunber  of  steps. 

800  WRITE  (CRT, 809) 

809  FORMAT  </, IX, ‘Enter  the  nunber  of  frequency  steps.  _■> 

READ  (CRT,*)  IFEND 

IF  (IFEND  .EQ.  9999)  CO  TO  9090 

IF  ((IFEND  .CT.  0)  .AND.  ( IFEND* ( lAENDtl )  .LE.  520))  GO  TO  825 
WRITE  (CRT, 819) 

819  FORMAT  (/, IX, ‘ERROR  •  WRi5  -  17002  . (WRi5)‘,/, 

*  IX, ‘NUMBER  OF  STEPS  MUST  BE  FROM  1  -  520/(AZIMUTH  STEPS  ♦  1).", 

*  /, IX, ‘REENTER  THE  NUMBER  OF  FREQUENCY  STEPS.”) 

GO  TO  800 

825  WRITE  (CRT, 829) 

829  FORMAT  (/, IX, ‘Enter  the  frequency  step  size  (MHz).  _”) 

READ  (CRT,*)  FSTEPS 
IF  (FSTEPS  .EQ,  9999)  GO  TO  9090 
DO  840  L  -  0,  IFEND  -  1 
F  -  RFREQ  t  L  *  FSTEPS 
CALL  CALF2(3,  MC,  F) 

CALL  CALF2(2,  MC,  FP) 

IF  (ABS(FP  -  F)  .LT.  1.)  CO  TO  840 
WRITE  (CRT,  838)  F 

838  FORMAT  (IX, 'ERROR  «  WR15  -  17010  . (WRi5)*,/, 

*  ‘THERE  IS  NO  CALIBRATION  DATA  FDR  FREQUENCY ‘ ,F7 . 0 ,/ , 

*‘  Select  one  of  the  following  nunbers  for  the  listed  result.”,/, 

*”  1.  Recalibrate.”,/, 

*‘  2.  Select  different  frequency  step  size  or  nunber  of  steps.”,/, 

*‘  3.  Proceed  with  these  frequencies,  do  not  correct  if  no  data.”) 
READ  (CRT,  *)  IANS 
IF  (IANS  .EQ.  1)  GO  TO  9000 
IF  (IANS  .EQ.  2)  GO  TO  800 
IF  (IANS  .EQ.  3)  CO  TO  850 
GO  TO  800 

840  CONTINUE 

850  WRITE  (CRT, 859)  II,  IFEND,  FSTEPS 

859  FORMAT  (lA2,‘a  52c  i4Y”,I3,”  *”,F5.0) 

GO  TO  610 

Inquire  fron  the  useri  azinuth  step  size  and  nunber  of  steps. 


C  Inquire  fron  the  useri  azinuth  step  size  and  nunber  of  steps. 

C - 

1000  WRITE(CRT,1100) 

1100  FORMAT(/,”  Enter  the  nunber  of  azinuth  steps  per  scan.  _”) 
READ(CRT,*)  lAEND 
IF  (lAEND  .EQ.  9999)  GO  TO  9090 

IF  ( (IFEND*(lAENDtl)  .LE.  520)  .AND.  (lAEND  .GT.  0))  GO  TO  1190 
WRITE  (CRT, 1109) 

1109  FORMAT  (/, IX, ‘ERROR  ♦  MR15  -  17203  . (WRi5)‘,/, 

*1X, ‘NUMBER  OF  STEPS  MUST  BE  FROM  1  -  520/(FREQUENCY  STEPS)-1 . ‘ ,/ , 
*  IX,  "REENTER  THE  NUMBER  OF  AZIMUTH  STEPS.”) 
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0239  GO  TO  1000 

0240  1190  WR1TE(CRT,1200) 

0241  1200  FORHAT</,"  Enter  the  step  size  (nn) .  *> 

0242  READ (CRT,*)  A3TEPS 

0243  IF  (ASTEPS  .EQ.  9999)  GO  TO  9090 

0244  URITE  (CRT, 1209)  II, IAENO,ASTEPS 

0245  1209  FORMAT  (lA2,'‘a  52e  6^,13,"  «“,F6.2) 

0246  GO  TO  610 

0247  C - 

0248  C  Inquire  fron  useri  elevotion  step  size  and  nunber  of  steps. 

0249  C - 

0250  2000  URITE  (CRT, 2009) 

0251  2009  FORMAT  (/,iX, "Enter  the  nunber  of  elevation  steps.  *) 

0252  READ  (CRT,*)  lEEND 

0253  IF  (lEENO  .EQ.  9999)  GO  TO  9090 

0254  IF  (lEEND  .GT.  0)  GO  TO  2028 

0255  WRITE  (CRT, 2019) 

0256  2019  FORMAT  (/, IX, "ERROR  #  UR15  -  17404  . (UR15)",/, 

0257  *  IX, "THE  NUMBER  OF  STEPS  MUST  BE  GREATER  THAN  0.",/, 

0258  *  IX, "REENTER  THE  NUMBER  OF  ELEVATION  STEPS.") 

0259  GO  TO  2000 

0260  2028  URITE  (CRT, 2029) 

0261  2029  FORMAT  (/, IX, "Enter  the  elevation  step  size  (nn) .  ") 

0262  READ  (CRT,*)  ESTEPS 

0263  IF  (ESTEPS  .EQ.9999)  GO  TO  9090 

0264  WRITE  (CRT, 2039)  II,  lEEND,  ESTEPS 

0265  2039  FORMAT  <lA2,"a  52c  7Y",I3,"  z",F6.2) 

0266  GO  TO  610 

0267  C - 

0268  C  Inquire  fron  the  user:  nicrowave  frequency. 

0269  C - 

0270  3000  URITE(CRT,3500) 

0271  3500  FORMAT(/,"  Enter  the  RF  frequency  (MHz)...  ") 

0272  READ(CRT,*)  RFREQ 

0273  IF  (RFREQ  .EQ.  9999)  GO  TO  9090 

0274  IF  ((RFREQ  .GE.  TEMPI)  .AND.  (RFREQ  .LE.  TEHP2) >  GO  TO  3600 

0275  URITE  (CRT, 3509)  TEMPI,  TEMP2 

0276  3509  FORMAT  (/, IX, "ERROR  ♦  WR15  -  17005  . ( WR15) " ,/, IX, 

0277  *  "CALIBRATION  ONLY  FROM  ",F6.0,"MHz  TO  " ,F6 . 0 , "MHz . "  , 

0278  *  /, IX, "FREQUENCY  MUST  BE  BETWEEN  CALIBRATION  LIMITS.", 

0279  *  /,lX,"Oo  you  wish  to  recalibrate?  (YES/NO)  *) 

0280  READ  (CRT, 3599)  IANS 

0281  3599  FORMAT  (A2) 

0282  IF  (IANS  .EQ.  2HYE)  GO  TO  9000 

0283  GO  TO  3000 

0284  3600  WRITE  (CRT,  3609)  II,  RFREQ 

0285  3609  FORMAT  (lA2,"a  54c  8Y",FS.0) 

0286  GO  TO  610 

0287  C - 

0288  C  Inquire  new  azinuth  position  and  call  UR6  to  set  it. 

0289  C - 

0290  4000  WRITE  (CRT, 4090) 

0291  4090  FORMAT  (/, IX, "Enter  new  azinuth  (nn) .  ") 

0292  READ  (CRT,*)  PRESAZ 

0293  IF  (PRESAZ  .EQ.  9999)  GO  TO  9090 

0294  CALL  SETPO  ( CRT ,LUAZ , PRESAZ, 2 , lERR > 

0295  IF  (lERR  .EQ.  0)  GO  TO  4400 

0296  CALL  WRi2  ( CRT , lERR ,. TRUE ., 0 , 0 , IPRNM , IPRNL ) 

0297  GO  TO  620 

0298  4400  WRITE  (CRT, 4409)  11, PRESAZ 
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4409  FORHAT  <1A2,"Q  52c  9Y-,F8.3) 

CO  TO  610 

C - 

C  Inquire  new  elevation  and  coll  UR6  to  eet  it. 

C - 

5000  WRITE  (CRT, 5090) 

5090  FORMAT  (/, IX, "Enter  new  elevation  ") 

READ  (CRT,*)  PRESEL 

IF  (PRESEL  .EQ.  9999)  GO  TO  9090 

CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

IF  (lERR  .EQ.  0)  GO  TO  5500 

CALL  WR12  (CRT, lERR, .TRUE. ,0,0, IPRNH,IPRNL) 

GO  TO  620 

5500  WRITE  (CRT, 5509)  II,  PRESEL 
5509  FORMAT  (lA2,"a  52c  i0Y",F8.3) 

GO  TO  610 

C - 

C  Inquire  fron  the  user;  nunber  of  readings  per  data  point. 

C - 

6000  WRITE  (CRT, 6009) 

6009  FORMAT  (/,iX, 

*  "Enter  nunber  of  readings  to  average  per  data  point.  ") 
READ  (CRT,*)  IRNUM 

IF  (IRNUM  .EQ.  9999)  GO  TO  9090 

IF  ((IRNUM  .LE.  32767)  .AND.  (IRNUM  .CT.  0))  CO  TO  6600 
WRITE  (CRT, 6509) 

6509  FORMAT  (/,iX, "ERROR  •  WR15  -  17006  . (WR15)",/, 

*  IX, "NUMBER  TO  AVERAGE  MUST  BE  FROM  1  -  32767.",/, 

*  IX, "REENTER  NUMBER  OF  READINGS  TO  AVERAGE  PER  POINT.") 

CO  TO  6000 

6600  WRITE  (CRT,  6609)  II,  IRNUM 
6609  FORMAT  (lA2,"a  S2c  11Y",I5) 

CO  TO  610 

C - - 

C  Inquire  fron  usert  nunber  of  scans  per  graph. 

C - 

7000  WRITE  (CRT, 7009) 

7009  FORMAT  (/, IX, "Enter  nunber  of  scans  between  graphs  on  screen.  _") 
READ  (CRT,*)  IPEND 
IF  (IPEND  .EQ.  9999)  GO  TO  9090 
IF  (IPEND  .CE.  0)  CO  TO  7500 
WRITE  (CRT, 7209) 

7209  FORMAT  (/, IX, "ERROR  •  WRIS  -  17007  . (WR15)",/, 

*  IX, "NUMBER  OF  SCANS  CAN  NOT  BE  LESS  THAN  0",/, 

*  IX, "REENTER  NUMBER  OF  SCANS  BETWEEN  GRAPHS  ON  CRT.") 

CO  TO  7000 

7500  WRITE  (CRT, 7509) 

7509  FORMAT  (/, IX, "Enter  »1»  to  plot  on  CRT  or  '0'  to  plot  on  ", 

*  "plotter.  ") 

READ  (CRT,*)  IGRLOC 
IPFLAC  >  1 

PLUNIT(l)  ■  4H-PL0 
PLUNIT(2)  ■  4HTTER 


0352  IF  (IGRLOC  .NE.  1)  CO  TO  7550 

0353  PLUNIT(l)  ■  4H  -  C 

0354  PLUNIT(2)  -  4HRT 

0355  7550  IF  (IPEND  .NE.  0)  GO  TO  7600 

0356  IPFLAC  -  0 

0357  PLUNlT(l)  >  4HCRAP 


0358  PLUNIT(2)  -  4HHS 
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7600  ISENO  *  1 

WHITE  (CRT,  7609)  II,  IPEND,  (PLUNIT( I ) , I-l ,2) 

7609  FORMAT  (lA2,''a  S2c  12Y'',I5,1X,2A4) 

GO  TO  610 

C - 

C  S«t  antenna*  to  first  position  ond  Croats  disc  doto  fils. 

C - 

C  Find  titls  for  fils. 

8000  WRITE  (CRT, 8009)  ( ITlTLd )  ,  I-l  ,40) 

8009  FORMAT  (/,1X, 

d’Enttr  titls  of  fils  or  prsss  'RETURN*  ksy  for  following  titls.", 
«/,40A2,/) 

C  Blank  out  rsst  of  80  bytss  of  titls. 

REG  -  EXEC  (i,401B,ITITL,-80> 

IF  (IREC(2)  .EQ.  0)  GO  TO  8100 
IF  (IREG(2)  .GT.  78)  GO  TO  8060 
DO  8050  I  -  (lREG(2)t3)/2,40 
8050  ITITLd)  -  2H 

8060  IF  ( (IREG(2)/2)«2  .EQ.  IREG(2) )  GO  TO  8100 

ITITL(lREG(2)/2+l)  -  (ITITLdREC(2)/2+l )/256)0256  ♦  32 
C  Sot  azinuth  to  -(1/2  of  scan). 

8100  POSITN  -  PRESAZ-ASTEPS*(IAEND~l)/2 
PARAM  -  POSITN 
CALL  WR6(PARAM,IERR,2,0) 

IF  (lERR  .EQ.O)  GO  TO  8200 

CALL  WR12(CRT,IERR, .TRUE. ,0,0, IPRNM,IPRNL) 

GO  TO  620 

C  Record  size  -  3  double  words  *  (steps  in  scan  *  1). 

8200  ISIZE(2)  >  6  «  (lAEND  *  1) 

C  Mininun  record  size  «  128. 

IF  (ISIZE(2)  .LT.  128)  ISIZE(2)  -  128 
C  File  size  «  record  size  *  (elevation  steps  *  frequency  steps  ♦  1). 
ISIZE(i)  -  (IS1ZC(2)  *  (lEEND  «  IFEND  ♦  1)  ♦  127)/128 
8300  NAMEF(3)  »  NAMEF(3)  ♦  1 

CALL  CREAT  ( IDCB, lERR ,NAMEF, ISIZE,2) 

IF  (lERR  .GE.  0)  GO  TO  8450 
IF  (lERR  .EQ.  -2)  GO  TO  8300 
WRITE  (CRT, 8409)  lERR 

8409  FORMAT  (/, IX, "ERROR  f",I3,"  OCCURED  IN  SUBROUTINE  CREAT") 

GO  TO  9090 

8450  IF  (PRNT  .EQ.  0)  GO  TO  8500 
C  Print  title  and  nenu  on  lins  printer. 

WRITE  (PRNT, 8459)  ( ITITL( I ) , I-l , 40 ) , (NAMEFd ) , I-l ,3) 

8459  FORMAT  ( "1 " , 40A2, /, IX, "FILE  -  ",3A2> 

WRITE  (PRNT, 600)  IAEND,ASTEPS, lEEND, ESTEPS, RFREQ,PRESAZ,PRESEL, 

«  IRNUM, IPEND, PLUNIT,PRNTL, IFEND, FSTEPS 

8500  WRITE  (CRT, 8509)  NAMEF 

8509  FORMAT  (/,1X,"NAME  OF  DATA  FILE  IS  *,3A2) 

C  Put  specifications  in  first  record. 

CALL  FTIME(IFAT) 

DO  8550  1-1,40 
8550  IFAT(15+I)  -  ITITLd) 

IFAT(S6)  -  ZHEL 
IFA7(S7)  -  0 
IFAT(58)  -  lAEND 
FAT (30)  »  ASTEPS 
IFAT(61)  «  0 
IFAT(62)  -  lEEND 
FAT(32)  -  ESTEPS 
FAT(33)  =  RFREQ 
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IFAT<67)  ■  ISIZE(l) 

IFAT(68)  -  ISIZE<2> 

IFAT(69)  -  0 
IFAT(70)  -  IFEND 
FAT(36)  ■  FSTEPS 
ILFLAG  •  1 

CALL  URITF  (lOCB,  lERR,  FAT) 

IF  (lERR  .EQ.  0)  GO  TO  8700 
WRITE  (CRT  8609)  lERR 

8609  FORHAT  (/, IX, "ERROR  •  ",13,"  OCCURED  IN  SUBROUTINE  WRITF") 

GO  TO  9090 

C - - - 

C  Elevation  scan  fron  PRESEL  to  PRESELt-ESTEPS«( IEEND-1 )  or  until  graph  needed 

- - 

8700  IF  (IPENO  .EQ.  0)  ISENO  -  lEENB 
ID  >  1 

IDRCT  -  1 

8701  DO  8900  J-l.ISEND 

IF  <J  +  IDONE  .EQ.  1)  GO  TO  8720 
C  If  not  first  scan,  switch  direction  and  increnent  elevation. 

IDRCT  -  -IDRCT 

PRESEL  >  PRESEL  ♦  ESTEPS 

PARAH  -  PRESEL 

CALL  UK6  (PARAH,  lERR,  4,  1) 

IF  (lERR  .EQ.  0)  GO  TO  8720 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

8720  CALL  WKl  (CRT,  LUEL,  TRUEL,  lERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8725 

CALL  UR12  (CRT,  lERR ,  .TRUE.,  0,0,  IPRNH,  IPRNL)  , 

GO  TO  9090  j 

C - 

C  Azinuth  scan  fron  PRESAZ-ASTEPS«( IAEND-1 )/2  to  PRE8AZ-^ASTEPS»( IAEND-1 )/2 
C - 

8725  DO  8800  l»l,IACND 
C  If  break  flag  set,  go  back  to  nenu . 

IF  (IFBRK(IERR))  523,8730 
8730  CALL  URl  (CRT,  LUAZ,  TRUAZ,  lERR ,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8735 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

CO  TO  y090 

C  Zero  X  and  y  before  starting  neosurenent  for  this  position. 

8735  DO  8740  IL  «  ID,  ID  +  (IFEND  -  1)  »  (lAND  1 ) ,  lAEND  *  1 
DAT(2,  IL)  »  0. 

DAT(3,  IL)  »  0. 

8740  CONTINUE 

C  Loop  for  statistics!  averaging. 

DO  8750  K  -  i,IRNUH 
C  Do  frequency  scan 

DO  8750  L  -  0,  IFEND  -  1 
IL  »  ID  4-  L  «  (lAEND  ■<-  1) 

F  -  RFREQ  ♦  L  *  FSTEPS 
CALL  CALF2(3,  HC,  F) 

CALL  HESUR  <F,  Xl,  Yl,  X,  Y) 

CALL  CORCT  (HC,  XI,  Yl,  X,  Y) 

DAT(3,  IL)  -  DAT(3,  IL)  ♦  Y 
8750  DAT(2,  IL)  »  DAT(2,  IL)  ♦  X 

DO  8790  L  «  0,  IFEND  -  1 
IL  >  ID  L  «  (lAEND  *  1) 

X  =  DAT(2,  IL)  /  IRNUH 
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Y  -  DAT(3,  ID  /  IRNUH 

DAT(3,  ID  >  ATAN2<Y,  X)  «  180.  /  3,141593 
DAT(2,  ID  «  -10  «  ALQGT(X«X  *  Y*Y) 

IF  (ILFLAG  .EQ.O)  GO  TO  8780 
F  >  RFREQ  L  «  FSTEP8 

WRITE  (CRT, 8779)  F,  TRUAZ,  DAT(2,  ID,  DAT(3,  ID 

8779  FORHAT  <1X,'FR£Q  »",F6. 0,5X, "AZIHUTH  -•,F8.3,SX, 

*  “RL0S8  ■“,F9.4,5X,“PHASE  -‘,F8.3) 

8780  DAT(1,  ID  «  TRUAZ 
8790  CONTINUE 

IF  (I  .GE.  lAENO)  GO  TO  8800 
10  -  10  ♦  lORCT 

POSITN  *  POSITN  *  lORCT  *  A8TEP8 

PARAN  >  PQ8ITN 

CALL  UR6<PARAH,IERR,2,0> 

IF  (lERR  .EQ.O)  GO  TO  8800 

CALL  WR12<CRT,IERR, .TRUE. ,0,0, IPRNH,IPRNL> 

GO  TO  9090 
8800  CONTINUE 

C - 

C  End  of  aziniuth  scan  loop. 

C - 

IF  (PRNT  .EQ.  0)  GO  TO  8830 
WRITE  (PRNT, 8829)  TRUEL 

8829  FORMAT  (//,5X, ‘ELEVATION  ■‘,F8.3) 

8830  DO  8890  L  >  1,  IFENO 

ILB  -  1  (L  -1)  «  (lAENO  *  1) 

ILE  >  L  «  (lAENO  *  1) 

DAT(1,ILE)  »  TRUEL 

DAT(2,ILE)  »  RFREQ  +  (L  -  1)  *  FSTEPS 
IF  (PRNT  .EQ.  0)  GO  TO  8850 
DO  8840  IE  >  ILB,ILE  -  1 

8840  WRITE  (PRNT,  8849)  DAT(2,ILE),  (DAT( I ,IE) ,I»1 ,3) 

8849  FORMAT  (IX, "FREQ  ,F6 . 0 ,5X, "AZIH  -•,FB.3, 

*  5X,"RL0SS  =",F8.3,5X,‘PHASE  »‘,F8.3) 

8850  CALL  WRITF  ( IDCB , lERR , DAT( 1 , ILB) ) 

IF  (lERR  .EQ.  0)  GO  TO  8890 

WRITE  (CRT, 8859)  lERR 

8859  FORMAT  (/, IX, ‘ERROR  ♦  ‘,I3,‘  OCCURED  IN  SUBROUTINE  WRITF") 
GO  TO  9090 
8890  CONTINUE 
8900  CONTINUE 

C - 

C  End  of  clavation  scan  loop 

C - 

IDONE  «  IDONE  *  ISEND 

C  If  no  scans,  go  to  reset  origianl  position. 

IF  (IPFLAG  .LT.  1)  GO  TO  515 
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C  Coll  EXEC  to  overlay  this  segnent  with  URt5C 

C - 

8990  IF  (IGRLOC  .EQ.  1)  GO  TO  8995 
INAME(3)  -  2HG 
GO  TO  8998 
8995  INAME(3)  »  2HT 
8998  CALL  EXEC  ( ICODE, INAME) 

9000  WRITE  (CRT, 9009) 

9009  FORMAT  (2/, IX, "Ron  progran  AGS02  for  new  calibration.") 
9090  WRITE  (CRT, 9099) 

09099  FORMAT  (/,10X, 


0539  «•««««««*»»•  PROCRAH  URlS  TERHINATED 

0540  CALL  CLOSE  (IDCB) 

0541  END 

0542  C - 

0543  C  Subroutine  8ETP0  calls  UR6  to  set  an  azinuth  or  elevation  position 
0544  C  and  then  calls  URl  to  check  the  position.  If  it  is  within  .002  it 
0545  C  returns,  if  not  it  calls  UR6  once  again. 

0546  C - 

0547  SUBROUTINE  6ETP0<CRT,LU, PRES, UNIT, lERR) 

0548  DO  100  1-1,2 

0549  PARAH  -  PRES 

0550  CALL  UR6  (PARAH, lERR , UNIT, 0) 

0551  IF  (lERR  .NE.  0)  RETURN 

0552  IF  (I  .GT.  1)  RETURN 

0553  C  IF  (LU  .EQ.  33)  GO  TO  90 

0554  CALL  URl  (CRT,LU,NEU, lERR , 0) 

0555  C  GO  TO  91 

0556  C  90  CALL  UR3  (CRT,LU,NEU, ieRR,0) 

0557  91  IF  (lERR  .NE.  0)  RETURN 

0558  IF  (AB8(NEU-PRES)  .LT.  .002)  RETURN 

0559  100  CONTINUE 

0560  RETURN 

0561  END 

0562  END* 
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SEGMENT  I  UR15C 
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FOR  I  Walter  R««d  Arny  Institute  of  Research 
Departnent  of  Microwave  Research 
Walter  Reed  Arny  Medical  Center 
Washington,  DC  20112 

++++++++++++++++++++++++-f+++++++++++++ 

BYi  Technology  USA,  Inc. 

P.O.  Box  55333 
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Segnent  WR15G  is  the  segment  of  WR15  that  plots  a 
groph  on  the  plotter.  It  is  read  in  and  control  passed 
to  it  by  an  EXEC(e,WRlSG>  call  from  segnent  WR15C  after 
a  scan  is  finished.  WRISC  then  plots  a  graph  on  the 
plotter  of  the  attenuation  versus  position  for  each 
frequency  with  a  marker  equal  to  the  frequency  number. 
When  this  segnent  is  finished,  it  calls  EXEC(8, WRISC)  to 
read  in  WRISC  and  pass  control  to  it. 


PROGRAM  WRISG.S 

DIMENSION  0AT<3,520),IPRNM(4),INAME(3) ,IDCB(144) ,NAMEF(3> , 

*  ISIZ£(2) ,iriTU<40) ,PLUNIT(2) 

INTEGER  STATUS,  ALPHLU,  GOUTLU,  CRT,  PRNT 

COMMON  OAT, IPRNM, INANE, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREQ, 

*  lAEND, TEMPI, TEMP2,IRNUM,RSTEPS,IREND,PRESR0,IDCB,NAMEF, 

*  ISIZE , IDONE , IPEND, ISEND , POSITN, IPFLAG , ILFLAG , ID , IDRCT , 

*  PLUNIT, ITITL,PRNT,FSTEPS, IFENO, ICRLOC 
DATA  ALPHLU,  GOUTLU  /I, 19/ 


STATUS  - 
ALPHLU  - 
GOUTLU  - 


Set  to  zero  if  no  errors  occur  in  o  colled  routine 
The  LU  of  the  alphanumeric  device 
The  LU  of  the  graphics  output  device 


C 
C 
C 
C 
C 

C**************************9******M*$*1it********$***********t*«**********M 

C 

c - 

C  Initialize  DGL  system 

C - 

WRITE(CRT,520> 

0520  FORMAT<"") 

CALL  ZBEGN 

C - 

C  Enable  all  devices,  exit  if  any  errors 

C - 

CALL  ENDEV  (ALPHLU, GOUTLU, STATUS) 

IF  (STATUS  .NE.  0)  GOTO  9990 

C - 


-144- 


I 


I 


00S9 

0060 

0061 

0062 

0063 

0064 

0065 

0066 

0067 

0068 

0069 

0070 

0071 

0072 

0073 

0074 

0075 

0076 

0077 

0078 

0079 

0080 

0081 

0C82 

0083 

0084 

0085 

0086 

0087 

0088 

0089 

0090 

0091 

0092 

0093 

0094 

0095 

0096 

0097 

0098 


0106 

0107 

0108 

0109 

0110 

0111 

0112 

0113 

0114 

0115 

0116 

0117 

0118 


C 

C- 


Find  nininun  and  naxinuM  value*. 


XHIN  «  DAT<1,1) 

XHAX  -  DATd.IAEND) 

YMIN  >  100000. 

YHAX  -  -100000. 

DO  5100  K  -  0,  IFEND  -  1 

DO  5100  I«14^(IAEND+1)«K,  IAENDX  lAEND-d  ) »K 
IF  (DAT(2,I)  .GT.  YMAX)  YMAX  ■  DAT<2,I) 

IF  <0AT<2,I)  .LT.  YHIN)  YHIN  -  DAT(2,I) 
5100  CONTINUE 


IF  (ABS(YNIN)  .NE.  YHIN)  GO  TO  5300 
YMIN  >  INT  (YHIN) 

GO  TO  5400 

5300  YMIN  -  INT  (YMIN  -  .999) 

5400  IF  <ABS(YHAX)  .NE.  YHAX)  GO  TO  5500 
YMAX  -  INT  (YMAX  ♦  .999) 

GO  TO  5600 

5500  YMAX  -  INT  (YMAX) 

5600  IF  ((YMAX-YMIN)  .LT.  6.)  YMAX  »  YMIN  ♦  6. 
IF  (ABS(XMIN)  .NE.  XMIN)  GO  TO  5700 
XMIN  «  INT  (XMIN) 

GO  TO  5800 

5700  XMIN  ■  INT  (XMIN  -  .999) 

5800  IF  (ABS(XMAX)  .NE.  XMAX)  GO  TO  5900 
XMAX  -  INT  (XMAX  +  .999) 

GO  TO  5950 

5900  XMAX  «  INT  (XMAX) 


C  Perforn  th*  vieuinq  transf omation ,  exit  if  any  errors 

C - 

5950  CALL  VIEWT  (STATUS, XMIN, XMAX, YMIN, YMAX) 

IF  (STATUS  .NE.  0)  GOTO  9990 


C  Draw  axis  and  label,  then  plot. 

C - 

CALL  D9MDT ( XMIN , XMAX , YMIN , YMAX , DAT , I AEND , IFEND ) 
GO  TO  ’QOO 


C  Disable  logical  devices 


0099 

c - 

0100 

C6000 

CALL 

ZNEUF 

0101 

c 

CALL 

CLEAR 

0102 

6000 

CALL 

ZAEN 

0103 

CALL 

ZDEND 

0104 

0105 

c - 

CALL 

ZEND 

C 

C- 


Call  EXEC  to  overlay  this  segnent  with  UR15C  and  execute  it 


9000  INAME(3)  -  2HC 

CALL  EXEC  (ICODE,  INANE) 
9990  CONTINUE 


CALL  ZAEND 
CALL  ZDEND 


C  Disable  DGL  systen 

C - 

CALL  ZEND 


-  H5- 


VJ 


sr‘ 


Oil? 
0120 
0121 
0122 
0123 
0124 
012S 
0126 
0127 
•  128 
0129 
0130 
0131 
0132 
0133 
0134 
0135 
0136 
0137 
0138 
0139 
0140 
0141 
0142 
0143 
0144 
0145 
0146 
0147 
0148 
0149 
0150 
0151 
0152 
0153 
0154 
0155 
0156 
0157 
0158 
0159 
0160 
0161 
0162 
0163 
0164 
0165 
0166 
0167 
0168 
0169 
0170 
0171 
0172 
0173 
0174 
0175 
0176 
0177 
0178 


C  Tcrninot«  progran 

C - 

9998  WRITE (CRT, 9999) 

9999  FORHATC") 

END 

C 


ENDEW  SUBROUTINE 


C  PURPOSE) 
C 


This  subrotttins  snablss  all  logical  dsvicss  ussd  by 
ths  program. 


C  DESCRIPTION)  This  subroutins  snablss  ths  DCL  work  statioiti  Ths  DGL 


workstation  contains  alphanunsric  and  graphics  output 
dsvicss. 


C  CALLING  SEQUENCE)  CALL  ENOEV<ALPHLU,COUTLU .STATUS) 
C 


C  PARAMETERS) 
C 


ALPHLU)  I INTEGER!)  Alphanunsric  LU 

GOUTLU)  IINTEGER!)  Graphics  output  LU 

STATUS)  (INTEGER!)  Sst  to  zsro  if  no  srrors  occur 

during  initialization  of  ths 
workstation.  It  is  sst  to  ths 
DCL  srror  rsturn  valus  if  an 
srror  is  found. 


C 

SUBROUT I NE  ENDEU ( ALPHLU , GOUTLU , STATUS > 
C 

INTEGER  ALPHLU,  GOUTLU,  STATUS 
INTEGER  CONTRL 


C  If  an  srror  occurs,  writs  out  an  srror  nsssags,  and  rsturn. 
C 

C  Enabls  alphanunsric  dsvics 


C  CALL  ZAINT  ( ALPHLU, STATUS) 

C  IF  (STATUS  .EQ.  0)  GOTO  1000 
C  CALL  ERRMS  (ALPHLU, STATUS, 6HZAINT  ) 

CIOOO  CONTINUE 


Enabls  graphical  display  dsvics  w/out  spooling)  s.g.  CONTRL  * 


CONTRL  »  0 

CALL  ZDINT  (GOUTLU, CONTRL, STATUS) 

IF  (STATUS  .EQ.  0)  GOTO  9999 
CALL  ERRMS  (ALPHLU, STATUS, 6HZDINT  ) 
9999  CONTINUE 


C  Rsturn  to  nain  progran  aftsr  oil  dsvicss  ors  propsrly  snablsd 

C - 

RETURN 

END 

C 

c 

c  SUBROUTINE  VIEWT 

C 


Ihis  subroutine  performs  the  initial  viewing 
transfornation. 


0179  C  PURPOSE: 

0180  C 
0181  C 

0182  C  DESCRIPTION:  This  subroutine  perforns  the  viewing  transf ornation  in 

0183  C  the  following  steps: 

0184  C 

018S  C  -  Places  the  inage  on  the  longest  possible  oreo 

0186  C  -  Sets  the  window  to  the  desired  ronge. 

0187  C  -  Resets  the  viewport  to  leave  roon  for  lobels 

0188  C  -  Rcconputes  character  size  based  on  specified  window 

0189  C 

0190  C  CALLING  SEQUENCE:  CALL  UIEUT 
0191  C 

0192  C  PARAMETERS:  NONE 

0193  C 

0194  C************************************************************************* 

019S  C 

0196  SUBROUTINE  UIEUT(STATUS,UXMIN,WXMAX »UYHIN,WYMAX) 

0197  C 

0198  INTEGER  IDUM,  lERR 

0199  REAL  AR<2) ,UIEU(4) >XSIZE,YSIZE>XCSIZ,YCSIZ 

0200  REAL  UXHIN,WXHAX,UYHIN>UYMAX,NINX,MAXX>HINY>MAXY 

0201  C 


0202 

C 

IDUM 

- 

Dunny 

1  uar 

0203 

C 

lERR 

- 

Error 

‘  rtturn 

1  <not  used) 

0204 

c 

AR 

- 

Holds  aspect 

ratio 

0205 

c 

VIEW 

- 

Holds  current 

viewport  bounds 

0206 

c 

XSIZE 

- 

Tenp 

work  variable 

0207 

c 

YSIZE 

- 

Tenp 

work  variable 

0208 

c 

XCSIZ 

- 

Tenp 

holder 

of 

character  size 

X 

0209 

c 

XCSIZ 

- 

Tenp 

holder 

of 

character  size 

Y 

0210 

c 

WXMIN 

- 

Tenp 

holder 

of 

window  X  -  nin 

0211 

c 

UXMAX 

- 

Tenp 

holder 

of 

window  X  -  nax 

0212 

c 

UYMIN 

- 

Tenp 

holder 

of 

window  Y  -  nin 

0213 

c 

UYMAX 

- 

Tenp 

holder 

of 

window  Y  -  nax 

0214 

c 

MINX 

- 

Tenp 

holder 

of 

new  viewport  X 

nin 

0215 

c 

MAXX 

- 

Tenp 

holder 

of 

new  viewport  X 

- 

nox 

0216 

c 

MINY 

- 

Tenp 

holder 

of 

new  viewport  Y 

- 

nin 

0217 

c 

MAXY 

- 

Tenp 

holder 

of 

new  viewport  Y 

- 

nax 

0218  C 

0219  C************************************************************************* 

0220  C 

0221  C  Inquire  ospect  ratio  of  loglcol  display  Units 

0222  C - 

0223  CALL  Z1W8  <2S4,0,2,1DUM,AR,IERR) 

0224  IF  (lERR  .EO.  0)  CO  TO  555 

0225  CALL  ERRMS  ( 1 , lERR ,6HZXWS  ) 

0226  GO  TO  9999 

0227  C - 

0228  C  Make  the  largest  possible  orea  of  the  logical  display  available 
0229  C  for  graphical  output  by  setting  the  aspect  ratio(AR). 

0230  C - 

0231  555  YSIZE  -  AR(2) 

0232  XSIZE  >1.0 

0233  CALL  ZASPK  <XSIZE, YSIZE) 

0234  C - 

0235  C  Specify  the  desired  range  of  X  and  Y  values  of  the  window 

0236  C - 

0237  CALL  ZWIND  <WXMIN,WXMAX,WYMIM,WYMAX) 

0238  C - 


0239 

0240 

0241 

0242 

0243 

0244 

0245 

0246 

0247 

0248 

0249 

0250 

0251 

0252 

0253 

0254 

0255 

0256 

0257 

0258 

0259 

0260 

0261 

0262 

0263 

0264 

0265 

0266 

0267 

0268 

0269 

0270 

0271 

0272 

0273 

0274 

0275 

0276 

0277 

0278 

0279 

0280 

0281 

0282 

0283 

0284 

0285 

0286 

0287 

0288 

0289 

0290 

0291 

0292 

0293 

0294 

0295 

0296 

0297 

0298 


C  Inquire  current  uiewport  Units 

C - 

CALL  ZIU8  (451,0, 4, IDUM, VIEW, lERR) 
IF  (lERR  .EQ.  0)  GO  TO  577 
CALL  ERRH8  < 1 , lERR ,6HZIUS  > 

GO  TO  9999 


C  Colculate  the  lower  left  hand  corner  of  the  uiewport  and  leave 
C  enough  roon  for  labels.  The  viewport  is  reduced  12Z  on  each  side 
C  to  give  roon  for  lables.  Set  the  new  viewport 

C - 

577  MINX  -  .12  «  U1EU<2> 

MAXX  -  .88  *  (;iEU<2) 

HINY  -  .12  «  V1EU(4) 

MAXY  «  .88  «  (;iEU<4) 

CALL  ZOIEU  (MINX, MAXX, MINY, MAXY) 

C - 

C  Now  set  the  character  size  based  on  the  size  of  the  window 
C  The  constonts  below  produce  a  readable  character  size  in  the  new 
C  window. 

C - 

XC3IZ  •  .015  «  (UXMAX  -  UXMIN) 

YCSIZ  >  ,025  «  (UYMAX  -  WYMIN) 

CALL  ZeSIZ  (XCSIZ, YCSIZ) 

C 

9999  RETURN 
END 

C  SUBROUTINE  DRUDT 

C  PURPOSE)  This  subroutine  draws  the  current  graph. 

C 

C  DESCRIPTION)  This  subroutine  clears  the  alphanuneric  and  graphics 
C  displays.  It  then  draws  the  current  graph.  Note 

C  that  if  the  user  has  not  changed  any  dato  values 

C  the  default  values  will  be  used. 

C 

C  CALLING  SEQUENCE;  CALL  DRWDT 
C 

C  PARAMETERS)  NONE 

C 

c***************t***tt***t********f$$**$***im*n****t*f$**t**t*******f**** 

c 

SUBROUTINE  DRWDT< XNIN,XMAX , YMIN , YMAX ,DAT , lAEND, IFEND) 

REAL  DAT (3, 520) 

DIMENSION  ILIST(3) ,RLIST(2) 

INTEGER  TEXT< 12) , OPCODE, RSIZE 
C 

REAL  UIEU(4) 

C 

C  VIEW  -  Tenp  holder  of  viewport  bounds 
C 

C**M*t**$*lft**Mlf**********9******n$***«t*********1f***********t***'$1it.***t*M 

C 

C  Clear  the  graphics  and  alphanuneric  displays 

- - 

CALL  ZNEUF 
CALL  CLEAR 

- - 

C  Deternine  paraneters  for  LAXE3  call.  Search  thru  data  for  YMAX. 


0299  C - 

0300  C - 

0301  XTIC  >  <XMAX-XHIN)/iO.O 

0302  YTIC  =  (YMAX-YMIN)  /  10.0 

0303  XORG  «  XHIN 

0304  YORG  >  YHIN 

030S  XMJC  »  1.0 

0306  YMJC  »  1.0 

0307  TSIZE  «  .02 

0308  CALL  LAXESCXTIC, YTIC, XORG, YORG, XHJC, YMJC, TSIZE) 

0309  C - 

0310  C  Plot  the  graph. 

0311  C - 

0312  DO  5500  K  «  0,IFEND-1 

0313  KM  »  HOO<K>10,19)  *  1 

0314  IK  =  (lAEND  >  1)  «  K 

0315  CALL  ZMQUE<DAT(l,lt-IK)  ,  DAT<2,l-tIK  ) ) 

0316  DATM  XHIN 

0317  DO  5000  I-2-tIK,  lAEND-t-IK  i 

0318  CALL  ZDRAU<DAT(1,I) ,DAT(2,I)) 

0319  IF  <DAT<1,I)  .LT.  DATM)  CO  TO  5000 

0320  DATM  »  DATM  +  5. 

0321  CALL  ZMARK<KM) 

0322  5000  CONTINUE 

0323  5500  CONTINUE 

0324  C - 

0325  C  Change  the  viewport  to  the  Moxlnun  posible  so  text  strings  nay  be 

0326  C  placed  anywhere  on  the  view  surToce .  Output  the  text  strings,  then 

0327  C  reset  the  viewport. 

0328  C - 

0329  6000  CALL  UPMAX  (UIEU)  * 

0330  TEXTd)  ■  2HRe  * 

0331  TEXT<2)  -  2Hla 

0332  TEXT(3)  «  2Hti 

0333  TEXT(4)  «  2Hve 

0334  TEXT(S)  »  2H  P 

0335  TEXT(6)  *  2Hos 

0336  TEXT(7)  =  2Hit 

0337  TEXT(8)  =  2Hio 

0338  TEXT(9)  ■  2Hn 

0339  TEXTdO)  =  2H<n 

0340  TEXTdl)  •  2Hn) 

0341  TEXT(12)  >  6412B 

0342  NMTEXT  -  24 

0343  XTEXT  *  XMIN  +  <XMAX  -  XMIN)  «  .3 

0344  YTEXT  ■  YMIN  +  < YNAX-YMIN)/21 . 0 

0345  C 

0346  CALL  ZMOVE  (XTEXT, YTEXT) 

0347  C  OPCODC«1052 

0348  C  ISIZE-1 

0349  C  RSIZE-0 

0350  C  ILIST(l)-6 

0351  C  CALL  ZOESC<OPCODE,ISIZE,RSIZE,ILIST,RLIST,IERR) 

0352  C  IF  (lERR  . EQ .  0)  GO  TO  6010 

0353  C  CALL  ERRMS  < 1 , lERR , 6HZOESC  ) 

0354  6010  CALL  ZTEXT  (NMTEXT, TEXT) 

0355  C 

0356  C  CALL  ZIESC ( 3050 , 3 , 0 , ILIST , RLIST , lERR > 

0357  C  IF  (lERR  .EQ.  0)  GO  TO  6020 

0358  C  CALL  ERRMb  ( 1 , lERR , 6HZIESC  ) 


-  U9- 


0359 
0360 
0361 
0362 
0363 
0364 
0365 
0366 
0367 
0368 
0369 
0370 
0371 
0372 
0373 
0374 
0375 
0376 
0377 
0378 
0379 
0380 
0381 
0382 
I  0383 
I  0384 
0385 
I  0386 
0387 
0388 
0389 
0390 
0391 
0392 
0393 
0394 
0395 
0396 
0397 
0398 
0399 
0400 
0401 
0402 
0403 
0404 
0405 
0406 
0407 
0408 
0409 
0410 
0411 
0412 
0413 
0414 
0415 
0416 
0417 
0418 


GO  TO  9999 


TEXT(l) 
TEXT(2) 
TEXT(3) 
TEXT(4> 
TEXKS) 
TEXT (6) 
TEXT < 7) 
TEXT(8) 
TEXT(9) 
NMTEXT  • 


2HAt 

2Htt 

2Hnu 

2Hat 

2Hio 

2Hn 

2H<d 

2Hb) 

6412B 

18 


XTEXT  -  XHIN  *  (XhAX  -XHIN)/30.0 
YTEXT  -  YMIN  ♦  <YHAX-YHIN)  *  .3 
OPCODE  a  250 
RLIST(l)  «  0 
RLIST<2)  -  1. 

ISIZE  «  0 
RSIZE  a  2 

CALL  ZHOVE< XTEXT, YTEXT) 

CALL  ZOESC<OPCODE , ISIZE, RSIZE, ILIST,RLIST, lERR > 
IF  (TERR  .EQ.  0)  GO  TO  6030 
CALL  ERRHS  ( 1 , lERR ,6HZ0ESC  > 

GO  TO  9999 

6030  CALL  ZTEXT<NMTEXT,TEXT> 

OPCODC»250 
RLISTd)  -  1. 

RLIST<2)  =»  0 
ISIZE  a  0 
RSIZE  =  2 

CALL  ZOESC<OPCODE, ISIZE, RSIZE, ILIST,RLIST,IERR) 
IF  (lERR  .EQ,  0)  CO  TO  6040 
CALL  ERRHS  ( 1 , lERR ,6HZ0ESC  ) 

GO  TO  9999 
C 

6040  CALL  ZVIEW  < VIEW< t ) , VIEl«2) ,VIEW<3) ,VIEW<4) ) 
CALL  ZMCUR 
C 

9999  RETURN 
END 
C 


PURPOSE: 


SUBROUTINE  ERRHS 
To  writ*  oMt  on  «rror  n«ssago . 


PARAHETERS: 


ALPHLU:  C INTEGER];  Th«  alphanunoric  LU 


ERROR 


SUBR : 


(INTEGER] t 


[INTEGER]; 


DESCRIPTION:  This  subroutins  writss  an  error  nessage  to  the  olphanuncrlc 

LU.  The  error  nunber  and  DGL  subroutine  nane  that  the  error 
occured  during  is  reported, 

CALLING  SEQUENCE:  CALL  ERRHS(ALPHLU, ERROR, SUBR) 


The  error  nunber  of  the  error  to 
reported 

An  array  containing  the  none  of 

the  subroutine  where  the  error  occured. 


•.'T'n.-Kr.'iL'r 


0419 

0420 

0421 

0422 

0423 

0424 

0425 

0426 

0427 

0428 

0429 

0430 

0431 

0432 

0433 

0434 

0435 

0436 

0437 

0438 

0439 

0440 

0441 

0442 

0443 

0444 

0445 

0446 

0447 

0448 

0449 

0450 

0451 

0452 

0453 

0454 

0455 

0456 

0457 

0458 

0459 

0460 

0461 

0462 

0463 

0464 

0465 

0466 

0467 

0468 

0469 

0470 

0471 

0472 

0473 

0474 

0475 

0476 

0477 

0478 


c 

SUBROUTINE  ERRMS  (ALPHLU, ERROR, SUBR > 

INTEGER  ALPHLU,ERR0R,SUBR(3> 

C 

C  Uritt  out  th«  error  Message 
C 

CALL  ZMCUR 

WRITE<ALPHLU,100)  ERROR,  SUBR 
100  FORMATC  Error  ‘,12,*  occured  in  subroutine  ”,3A2) 

C 

RETURN 

END 

C 

C  SUBROUTINE  CLEAR 

C 

C  PURPOSE:  To  clear  the  alphanuncric  disploy 

C 

C  DESCRIPTION:  This  subroutine  will  clear  the  alphanuneric  display 
C  oP  a  HP  2647  or  HP  2648  terninal.  If  the  display  is 

C  not  a  HP  2647  or  HP  2648  then  the  call  has  no  effect. 

C 

C  CALLING  SEQUENCE:  CALL  CLEAR 
C 

C  PARAMETERS:  NONE 

C 

C 

SUBROUTINE  CLEAR 

INTEGER  1LIST<7),  STRING<2),  lERR  | 

REAL  DUMMY  ^ 

C 

C  ILIST  ~  Infornation  list  returned  by  ZIUS 
C  lERR  -  Error  infornation  returned  by  ZIUS  (not  used  here) 

C  DUMMY  -  Real  infornation  returned  by  ZIUS  (none  in  this  cose) 

C  STRING  -  Device-dependent  connands  that  clear  a  264X  tcrninol 


DATA  STRING  /ISSSOB, 

/  \ 

33B  +  ISOB 

esc  h 

(hone  cursor) 


lS5i2B/ 

/  \ 

33B  li2B 
esc  J 

(clear  display) 


C 

C  Inquire  the  status  of  the  olphanuneric  device; 

C  upon  return,  IHST(4)  ■  -1  *»>  no  olpho  device, 

C  >0  «3>  it  is  disobled, 

C  >1  >«>  it  is  enobled. 

C  If  it  is  not  enobled,  just  return. 

C 

CALL  ZIUS  (7050, 7,0, ILIST, DUMMY, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  7070 
CALL  ERRMS  ( 1 , lERR ,6HZ1US  ) 

GO  TO  9999 

7070  IF  (ILIST(4)  . NE .  1)  GOTO  9999 
C 

C  Alpho  device  is  enabled.  Make  sure  it  is  '264X'  type  then  clear. 
C 
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IF  (ILIST<1)  .NE.  2H26)  GOTO  9999 

IF  ((ILIST<2)  .NE.  2H47)  .AND.  <ILIST(2)  .NE.  2H48))  GOTO  9999 
CALL  ZALPH  (4, STRING) 

C 

9999  RETURN 
END 
C 

c 

C  SUBROUTINE  UPHAX 

C 

C  PURPOSE:  S«t  th«  viewport  to  the  naxlnun  Unite. 

C 

C  DESCRIPTION:  The  current  viewport  is  moved  in  VZEU.  The  viewport 

C  ie  then  set  to  the  noxinun  linite. 

C 

C  CALLING  SEQUENCE:  CALL  UPHAX  (VIEW) 

C 

C  PARAMETERS: 

C  VIEW:  [REAL  ARRAY  OF  41)  This  array  contoins  the 

C  viewport  before  it  woe 

C  noxunized. 

C 

c 

SUBROUTINE  UPMAX  (UIEU) 

REAL  VIEU<4) 

C 

INTEGER  lOUH 
REAL  AR(2),  NEUX,  NEUY 
C 

C  IDUH  -  Dunny  work  variable 

C  AR  -  Tenp  holder  of  the  aspect  ratio 

C  NEUX  -  Tenp  work  variable 

C  NEWY  -  Tenp  work  variable 

C 

C$*$$**$$*$$*$****$*$$*»**$*4t*$1i«******$*****$*$$**$$**$$$**$$***$$**$«*** 

C 

C  Inquire  current  viewport  and  save  it  in  orray  VIEW 
C 

CALL  ZIUS  (451, 0,4, IDUH, VIEW, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  8080 
CALL  ERRHS  ( 1 , lERR ,6HZIUS  ) 

GO  TO  9999 
C 

C  Inquire  the  naxinun  aspect  ratio 
C 

8080  CALL  ZIMS  <254 , 0 , 2 , IDUH, AR , lERR ) 

C 

C  Set  viewport  to  naxinun  dinensions 
C 

NEWY  ■  1. 

NEUX  -  1. 

IF  <AR<2)  .LE.  1.)  NEWY  »  AR<2) 

IF  (AR<2)  .GT.  1.)  NEWX  ■  i./AR<2) 

CALL  ZUIEU  (0.0, NEUX, 0.0, NEUY) 

C 

9999  RETURN 
END 
END* 
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SEGMENT:  WRIST 


Waiter  Reed  Arny  Institute  of  Research 
Departnent  of  Nicrowavc  Research 
Walter  Reed  Arny  Hedical  Center 
Washington,  DC  20112 

♦++++•*•♦++++♦■♦■++++++++++++++++♦+++♦+♦++ 

Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone t  <301)  292-2592 


C  K  Segment  WRIST  is  the  segment  of  WR15  thot  plots  a  * 

C  t  graph  on  the  terminol.  it  is  read  in  and  control  passed  t 

C  *  to  it  by  an  EXEC(8, WRIST)  coll  from  segment  WR15C  after  « 

C  «  a  scan  is  finished.  WRIST  then  disploys  a  groph  on  the  * 

C  *  CRT  of  the  attenuation  versus  position  for  eoch  * 

C  t  freguency,  with  a  morker  equal  to  the  frequency  number.  * 

C  *  frequency.  When  this  segment  finishes,  this  graph  is  « 

C  «  still  displayed  while  the  next  scon  is  done  ond  is  erosed  * 

C  *  before  the  next  graph  is  plotted.  The  last  graph  is  * 

C  «  displayed  while  the  antennoe  are  repositioned  and  then  * 

C  «  UR15C  turns  off  the  graphic  display  without  erasing  it.  * 

C  *  The  user  can  reenable  the  display  by  pressing  the  ‘SHIFT*  « 

C  *  and  "G  CURSOR*  keys.  When  this  segment  is  finished,  it  « 

C  «  calls  CXEC(8,WR15C)  to  reod  in  UR15C  and  poss  control  to  « 

C  *  it.  * 

PROGRAM  WR15T,5 
C 

DIMENSION  DAT<3,520),IPRNN(4),INAME(3) ,IDCB<144) ,NAMEF(3) , 

*  ISIZE<2),ITITL<40),PLUNIT(2) 

INTEGER  STATUS,  GOUTLU,  CRT,  PRNT 

COMMON  DAT, IPRNM,INAME, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREQ, 

*  IAEND,TEMP1,TEMP2,IRNUM,RSTEPS,IREND,PRESR0,IDCB,NAMEF, 

*  I SIZE , IDONE , IPEND , ISEND , POSI TN ,  IPFLAG , ILFLAG , I D , IDRCT , 

*  PLUNIT , IT ITL ,PRNT ,FSTEPS , IFEND , IGRLOC 
EQUIVALENCE  (CRT,  GOUTLU) 

C 

C  STATUS  -  Set  to  zero  if  no  errors  occur  in  a  called  routine 
C  GOUTLU  -  The  LU  of  the  graphics  output  device 
C 

C««»«««*$«««*«*««**«t«««««»**««««*«*«««»**««**«****«*«««««***««««*««*«**«« 

c 

C - 

C  Initialize  DGL  system 

C - 

WR1TE(CRT,520) 

0520  FORMAT<*") 

CALL  ZBEGN 

C - 
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C  Enable  oil  devices,  exit  if  ony  errors 

C - 

CALL  ENDEV  ( CRT, GOU FLU, STATUS) 

IF  (STATUS  .NE.  0)  GOTO  9990 


C  Find  nininun  and  naxinun  volues. 

C - - - 

XHIN  -  DAT(1,1> 

XHAX  «  DATd.IAENO) 

YHIN  -  100000. 

YHAX  «  -100000. 

DO  5100  K  -  0,  IFEND  -  1 

DO  5100  I>lt-(IAEND-i>l>«K,  IAEND-t(  lAEND-tl ) *K 
IF  <DAT<2,1)  .CT.  YHAX)  YHAX  -  DAT(2,I) 

IF  (DAT<2,I)  .LT.  YHIN)  YHIN  •  DAT(2,I) 

5100  CONTINUE 

IF  <ABS<YHIN)  .NE.  YHIN)  CO  TO  5300 
YHIN  -  INT  (YHIN) 

GO  TO  5400 

5300  YHIN  «  INT  (YHIN  -  .999) 

5400  IF  (ABS(YHAX)  .NE.  YHAX)  GO  TO  5500 
YHAX  ■  INT  (YHAX  ♦  .999) 

GO  TO  5600 

5500  YHAX  =  INT  (YHAX) 

5600  IF  ((YHAX-YHIN)  .LT.  6.)  YHAX  ■  YHIN  ♦  6. 

IF  (ABS(XHIN)  .NE.  XHIN)  CO  TO  5700 
XHIN  -  INT  (XHIN) 

GO  TO  5800 

5700  XHIN  ■  INT  (XHIN  -  .999) 

5800  IF  <ABS(XHAX)  .NE.  XHAX)  GO  TO  5900 
XHAX  «  INT  (XHAX  ♦  .999) 

GO  TO  5950 

5900  XHAX  -  INT  (XHAX) 

C - 

C  Perforn  the  viewing  transf ornation ,  exit  if  any  errors 

C - 

5950  CALL  VIEMT  (STATUS, XHIN, XHAX, YHIN, YHAX) 

IF  (STATUS  .NE.  0)  GOTO  9990 


C  Draw  axis  and  label,  then  plot. 

C - 

CALL  ORWDT(XHIN,XHAX,YHIN,YHAX,OAT,IAEND, IFEND) 
GO  TO  9000 


C  Disable  logical  devices 


C6000  CALL  ZNEUF 

C  CALL  CLEAR 

6000  CALL  ZAEND 

CALL  ZDEND 
CALL  ZEND 


C  Call  EXEC  to  overlay  this  segnent  with  UR15C  and  execute  it 

C - 

9000  INAHE(3)  >  2HC 

CALL  EXEC  (ICODE,  INAHE) 

9990  CONTINUE 
C 

CALL  ZAEND 
CALL  ZDEND 
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C  DiSQblt  DGL  systcn 


CALL  ZEND 


C  Ttrninatt  program 


9998  WRITE (CRT, 9999) 

9999  FORMAT! •") 

END 


PURPOSE; 


DESCRIPTION; 


ENDEV  SUBROUTINE 

This  subroutine  snablss  all  logical  devices  used  by 
The  program. 

This  subroutine  enables  the  DGL  work  station.  The  DGL 
workstation  contains  alphanuneric  and  graphics  output 
devices . 


CALLING  SEQUCNCL'i  CALL  ENDEV(ALPHLU,COUTLU, STATUS) 


C  PARAMETERS: 

C  ALPHLU;  (INTEGER);  Alphanuneric  LU 

C  GOUTLUi  (INTEGER);  Graphics  output  LU 

C  STATUS)  (INTEGER);  Set  to  zero  if  no  errors  occur 

C  during  initializotion  of  the 

C  workstotion.  It  is  set  to  the 

C  DGL  error  return  value  if  an 

C  error  is  found.  ] 

C  * 

C***M**t***fM*******t******M*t******t****$*M***t**9**t***9**9***$**$$**W 
C 

SUBROUTINE  ENDEV < ALPHLU , GOUTLU , STATUS ) 

C 

INTEGER  ALPHLU,  GOUTLU,  STATUS 
INTEGER  CONTRL 


G158  C  If  an  error  occurs,  write  out  an  error  nessage,  and  return. 

0159  C 

0160  C  Enable  olphanuneric  device 

0161  C - 

0162  CALL  ZAINT  (ALPHLU, STATUS) 

0163  IF  (STATUS  .EQ.  0)  GOTO  1000 

0164  CALL  ERRMS  (ALPHLU, STATUS, 6HZAINT  > 

0165  1000  CONTINUE 

0166  C - 

0167  C  Enable  graphical  display  device  w/out  spooling;  e.g.  CONTRL  ■  0. 

0168  C - 

0169  CONTRL  ■  0 

0170  CALL  ZDINT  (GOUTLU, CONTRL, STATUS) 

0171  IF  (STATUS  .EQ.  0)  GOTO  9999 

0172  CALL  ERRMS  (ALPHLU, STATUS, 6HZD1NT  ) 

0173  9999  CONTINUE 

0174  C - - - 

0175  C  Return  to  nain  progran  after  oil  devices  are  properly  enabled 

0176  C - 

0177  RETURN 

0178  END 
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C 

C  SUBROUTINE  VIEUT 


DESCRIPTION: 


C  PURPOSE:  This  subroutine  porforns  the  initial  uitwinq 

C  transf ornation . 

C 

C  DESCRIPTION:  This  subroutins  porforns  the  uiowing  transf ornotion  in 

C  tho  following  stops: 

C 

C  -  Places  tho  inago  on  tho  largest  possible  ores 

C  -  Sots  tho  window  to  tho  desired  rongo. 

C  -  Resets  the  viewport  to  leave  roon  for  labels 

C  -  Reconputes  character  size  based  on  specified  window 

C 

C  CALLING  SEQUENCE:  CALL  UlEWT 
C 

C  PARAHETERS:  NONE 

C 

Ct**tt**trntit****t1tM**tt*t*tim**t****$**t********f*t********f*tt**$t*$$*« 

c 

SUBROUTINE  U I EUT < STATUS , UXHI N , UXHAX , UYH I N > NY HAX > 

C 

INTEGER  IDUH,  lERR 

REAL  AR<2) ,UIEU<4) ,XSIZE,YSIZE,XCSIZ, YCSIZ 
REAL  UXHIN,UXMAX>UYNIN>UYMAX,MINX,HAXX,HINY>HAXY 
C 

C  IDUH  -  Dunny  var 

C  lERR  -  Error  return  <not  used) 

C  AR  -  Holds  aspect  ratio 

C  UIEU  -  Holds  current  viewport  bounds 

C  XSIZE  -  Tenp  work  variable 

C  YSIZE  -  Tenp  work  variable 

C  XCSIZ  -  Tenp  holder  of  character  size  X 

C  XCSIZ  -  Tenp  holder  of  character  size  Y 

C  UXHIN  -  Tenp  holder  of  window  X  -  nin 

C  WXHAX  -  Tenp  holder  of  window  X  -  na* 

C  UYMIN  -  Tenp  holder  of  window  Y  -  nin 

C  UYHAX  -  Tenp  holder  of  window  Y  -  nax 

C  MINX  -  Tenp  holder  of  new  viewport  X  -  nin 

C  MAXX  -  Tenp  holder  of  new  viewport  X  -  nox 

C  MINY  -  Tenp  holder  of  new  viewport  Y  -  nin 

C  MAXY  -  Tenp  holder  of  new  viewport  Y  -  nax 

C 

C 

C  Inquire  aspect  ratio  of  logical  display  Units 

- - 

CALL  ZIUS  <254, 0,2, IDUH, AR, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  555 
CALL  ERRMS  < 1 , iERR,6HZIW8  ) 

GO  TO  9999 

- - 

C  Moke  the  largest  possible  area  of  the  logical  display  available 
C  for  graphical  output  by  setting  the  ospect  ratio(AR). 

- - 

555  YSIZE  =«  AR(2) 

XSIZE  >1.0 

CALL  ZASPK  <XSIZE, YSIZE) 


V.v.v- 


0239  C - 

0240  C  Specify  the  desired  range  of  X  and  Y  values  of  the  window 

0241  C - 

0242  CALL  ZWIND  (UXHlN,UXHAX,UYniN,UYnAX) 


0242  CALL  ZWIND  (UXN1N,UXHAX,UYNIN,UYNAI 

0243  C - 

0244  C  Inquire  current  viewport  Units 

0245  C - 

0246  CALL  ZIU8  (451 , 0 »4, IDUH, VIEW, lERR ) 

0247  IF  (lERR  .EQ.  0)  CO  TO  577 

0248  CALL  ERRHS  ( 1 , IERR>6HZIUS  ) 

0249  GO  TO  9999 
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C  Colculote  the  lower  left  hand  corner  of  the  viewport  and  leave 
C  enough  roon  for  labels.  The  viewport  is  reduced  12X  on  eoch  side 
C  to  give  roon  for  lables.  Set  the  new  viewport 

C - 

577  HINX  -  .12  «  VIEW(2) 

HAXX  -  .88  «  UIEW(2) 

MINY  -  .12  «  V1EW<4) 

MAXY  >  .88  «  VIEW<4) 

CALL  ZWIEW  (MINX, HAXX, MINY, HAXY) 

C - 

C  Now  set  the  character  size  based  on  the  size  of  the  window 
C  The  constants  below  produce  a  readable  choracter  size  in  the  new 
C  window. 

C - 

XCSIZ  >  .015  «  (UXMAX  -  UXHIN) 

YCSIZ  -  .025  *  (UYMAX  -  WYMIN) 

CALL  ZeSIZ  (XCSIZ, YCSIZ) 

C 

9999  RETURN 
END 

C  SUBROUTINE  ORWDT 

C 

C  PURPOSE:  This  subroutine  draws  the  current  graph. 

C 

C  DESCRIPTION:  This  subroutine  clears  the  alphanuneric  and  graphics 
C  displays.  It  then  draws  the  current  graph.  Note 

C  that  if  the  user  has  not  changed  any  data  values 

C  the  default  values  will  be  used. 

C 

C  CALLING  SEQUENCE:  CALL  DRWDT 
C 

C  PARAMETERS:  NONE 

C 

C****t*****t****$*******t**********$***$************************t*9******* 

C 

SUBROUTINE  DRWDT ( XMIN , XMAX , YHIN , YMAX , DAT , I AEND , I FEND ) 

REAL  DAT (3, 520) 

DIMENSION  ILIST(3) 

INTEGER  TEXT( 12), OPCODE, RSIZE 
C 

REAL  UIEW(4) 

C 

C  VIEW  -  Tenp  holder  of  viewport  bounds 
C 

C 

C  Clear  the  graphics  and  alphanuneric  displays 
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0  333 


CALL  ZNEUF 
CALL  CLEAR 


C  Dctcrninc  paranattrs  for  LAX 
C - 

C - 

XTIC  -  <XMAX-XMIN)/10.0 

YTIC  -  <YMAX-YHIN)  /  10.0 

XORG  >  XHIN 

YQRG  >  YHIN 

XMJC  «  1.0 

YMJC  -1.0 

TSIZE  -  .02 

CALL  LAXES(XTIC. YTIC, XORG 


Plat  the  graph. 


DO  SSOO  K  >  0,  IFEND  -  1 
KH  >  HaD<Ktl0,19)  *  1 
IK  «  (lAEND  t  1)  «  K 
CALL  ZMQV^E<DAT<l,ltIK)  ,DA 
OATH  -  XHIN 

DO  5000  I>2+IK,  lAEND-tlK 
CALL  ZDRAU(DAT<l,I)>DAT<e 
IF  (DAT<1,I)  .LT.  DATH)  G 
DATH  -  DATH  ♦  5. 

CALL  ZHARK(KH) 

5000  CONTINUE 
5500  CONTINUE 

C - 

C  Change  the  viewport  to  the  r 
C  placed  anywhere  on  the  view 
C  reset  the  viewport. 

C - 
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0343 

TLXT(9)  =»  2Hn 

0344 

TEXTCIO)  =  2H<ri 

0345 

TEXT<11)  =  2H(i) 

0346 

TEXT(12)  =  6412B 

0347 

NHTEXT  »  24 

0348 

XTEXT  =0.0 

0349 

YTEXT  =  YHIN  ♦  <YHAX-YH 

0350  C 

0351 

CALL  ZHOVE  (XTEXT, YTEXT 

0352 

OPCOD£=1052 

0  353 

ISIZE=1 

0354 

RSIZE=0 

0355 

ILlSTd)  =6 

0356 

CALL  ZOESC(OI-’CODE,ISIZE 

0357 

IF  < lERR  .EQ.  0)  GO  TO 

0  358 

CALL  ERRMS  (1,IERR,6H 

I 


I 


I 
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I 

1 


1 


0359 

0360 

0361 

0362 

0363 

0364 

0365 

0366 

0367 

0368 

0369 

0370 

0371 

0372 

0373 

0374 
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6010  CALL  ZTEXT  (NMTEXT,TEXT) 

C 

C  CALL  ZIESC(3050,3,0,ILIST,RLI5T,IERR> 

C  IF  (lERR  .EQ.  0)  GO  TO  6020 

C  CALL  ERRHS  ( 1 , lERR »6HZIESC  ) 

C  GO  TO  9999 

6020  TEXT(l)  -  2HAt 
TEXT<2)  -  2Ht« 

TEXT(3)  ■  2Hnu 
TEXT(4)  »  2HQt 
TEXT<S)  ■  2Hio 
TEXT < 6)  »  2Hn 
TEXT(7)  -  2H<d 
TEXT(8)  ■  2Hb) 

TEXT<9)  -  6412B 
NMTEXT  -  18 

XTEXT  -  XMIN  *■  <XMAX  -XHIN)/30.0 

YTEXT  -  YHIN  ♦  < YMAX-YMIN>/2 . 0 

OPCODE  -  1050 

ILIST(l)  «  1 

ISIZE  ■  1 

RSIZE  >  0 

CALL  ZMOVE( XTEXT, YTEXT) 

CALL  ZOESC( OPCODE , ISIZE, RSIZE, ILIST,RLIST, lERR ) 

IF  (lERR  .EQ.  0)  GO  TO  6030 
CALL  ERRMS  < 1 , lERR ,6HZ0ESC  > 

GO  TO  9999 

6030  CALL  ZTEXT<NHTEXT,TEXT) 

OPCODC>1050 
ILISTd)  »  0 

ISIZE  »  1  1 

RSIZE  -  0  ^ 

CALL  ZOESC<OPCODE, ISIZE, RSIZE, ILIST,RLIST, lERR  > 

IF  <IERR  .EQ.  0)  GO  TO  6040 
CALL  ERRMS  ( 1 , lERR , 6HZ0ESC  > 

GO  TO  9999 


6040  CALL  ZV)IEU  (V)IEW(  1 )  ,VIEN<2>  ,VIEW(3>  ,9IEU(4) ) 
CALL  ZMCUR 

9999  RETURN 
END 


c 
c 
c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE! 

DESCRIPTION! 


SUBROUTINE  ERRMS 
To  write  out  an  error  message. 


This  subroutine  writes  an  error  nessage  to  the  olphanu»*er ic 
LU.  The  error  nunber  and  DCL  subroutine  nane  that  the  error 
occured  during  is  reported. 


CALLING  SEQUENCE:  CALL  ERRMS<ALPHLU, ERROR, 5UBR) 

PARAMETERS! 

ALPHLU:  [INTEGER];  The  alphanuncric  LU 

ERROR;  [INTEGER]}  The  error  number  of  the  error  to 

reported 
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0419 

0420 

0421 

0422 

0423 

0424 

042S 

0426 

0427 

0428 

0429 

0430 

0431 

0432 

0433 

0434 

0435 

0436 

0437 

0438 

0439 

0440 

0441 

0442 

0443 

0444 

0445 

0446 

0447 

0448 

0449 

0450 

0451 

0  452 

0453 

0454 

0455 

0  456 

0457 

0458 

0459 

0460 

0461 

0462 

0463 

0464 

0465 

0466 

0467 

0468 

0469 

0470 

0471 

0472 

0473 

0474 

0475 

0476 

0477 

0  478 


SUBRi  (INTEGER!;  An  array  containing  tht  nan«  of 

Tht  subroutina  whcrt  the  error  occured. 


c 

SUBROUTINE  ERRNS  < ALPHLU, ERROR ,SUBR ) 

INTEGER  ALPHLU, ERROR, SUBR(3) 

C 

C  Write  out  the  error  nessage 
C 

CALL  ZMCUR 

URITE(ALPHLU,100)  ERROR,  SUBR 
100  FORHATt*  Error  *,I2,*  occured  in  subroutine  *,3A2) 
C 

RETURN 

END 

C 


PURPOSE) 


SUBROUTINE  CLEAR 


To  clear  the  alphanuneric  display 


C  DESCRIPTION)  This  subroutine  will  clear  the  alphanuneric  display 
C  of  a  HP  2647  or  HP  2648  terninal.  If  the  disploy  is 

C  not  a  HP  2647  or  HP  2648  then  the  call  has  no  effect. 

C 

C  CALLING  SEQUENCE)  CALL  CLEAR 
C 

C  PARAMETERS)  NONE 

C 

Ct******$*****tt*$*«t***t****tt**1f*$*f$****t****$*1t*********************** 

c 

SUBROUTINE  CLEAR 

INTEGER  ILIST<7),  STRING<2),  lERR 
REAL  DUMMY 
C 

C  ILIST  -  Information  list  returned  by  ZIW3 
C  lERR  -  Error  information  returned  by  ZIWS  (not  used  here) 

C  DUMMY  -  Real  information  returned  by  ZIWS  (none  in  this  case) 

C  STRING  -  Device-dependent  commands  that  clear  a  264X  terminal 


DATA  STRING  /15550B, 

/  \ 

33B  *  ISOB 

esc  h 

(home  cursor) 


15512B/ 

/  \ 

33B  +  112B 

esc  J 

(cleor  display) 


C**********************M**t*M*$********t********************t************* 

C 

C  Inquire  the  status  of  the  alphanumeric  deuicei 
C  upon  return,  ILIST(4)  *  -1  =■>  no  alpha  device, 

C  “0  »»>  it  is  disabled, 

C  »  1  =«>  it  is  enobled. 

C  If  it  is  not  enabled,  just  return. 

C 

CALL  ZIWS  (7050,7, 0, ILIST, DUMMY, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  7070 
CALL  ERRMS  ( 1 , lERR ,6HZIUS  ) 

GO  rO  9999 

7070  IF  (ILIST(4)  , NE ,  1)  GOTO  9999 


I 


Kt 

u 
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0479  C 

0480  C  Alpha  d«vic«  is  snablcd.  Maks  surs  it  is  '264X'  typt  thsn  clsar. 

0481  C 

0482  IF  (ILIST(l)  .NE.  2H26)  GOTO  9999 

0483  IF  <(ILIST(2)  .NE.  2H47)  .AND.  (ILIST(2)  .NE.  2H48))  GOTO  9999 

0484  CALL  ZALPH  <4>STfiINC) 

0485  C 

0486  9999  RETURN 

0487  END 

0488  C 

0489  Ct**t******f •************%*********************************%************* 

0490  C 

0491  C  SUBROUTINE  VPMAX 

0492  C 

0493  C  PURPOSE;  Sst  ths  viewport  to  tht  naxinuM  Units. 

0494  C 

0495  C  DESCRIPTION:  Ths  current  viewport  is  saved  in  VIEW.  The  viewport 

0496  C  is  then  set  to  the  naxinun  Units. 

0497  C 

0498  C  CALLING  SEQUENCE;  CALL  UPMAX  (VIEW) 

0499  C 

0500  C  PARAMETERS: 

0501  C  VIEW:  [REAL  ARRAY  OF  41}  This  array  contains  the 

0502  C  viewport  before  it  was 

0503  C  naxunized. 

0504  C 

0505  Ct**tit*********t**********tt***********t*f  ********************$•****%**•* 

0506  C 

0507  SUBROUTINE  VPMAX  (VIEW) 

0508  REAL  V1EU(4) 

0509  C 

0510  INTEGER  IDUM 

0511  REAL  AR<2),  NEWX,  NEWY 

0512  C 

0513  C  IDUH  -  Dunny  work  variable 

0514  C  AR  -  Tenp  holder  of  the  aspect  ratio 

0515  C  NEWX  -  Tenp  work  variable 

0516  C  NEUY  -  Tenp  work  variable 

0517  C 

0519  C 

0520  C  Inquire  current  viewport  and  save  it  in  orray  VIEW 
0521  C 

0522  CALL  ZIWS  <451 , 0 , 4 , IDUM, VIEW, lERR ) 

0523  IF  (lERR  .EQ.  0)  GO  TO  8080 

0524  CALL  ERRNS  ( 1 , lERR ,6HZIWS  ) 

0525  GO  TO  9999 

0526  C 

0527  C  Inquire  ths  naxinun  aspect  ratio 

0528  C 

0529  8080  CALL  ZIWS  (254 , 0 , 2 , IDUM, AR , lERR ) 

0530  C 

0531  C  Set  viewport  to  naxinun  dincnsions 

0532  C 

0533  NEWY  •  1. 

0534  NEWX  «  1  . 

0535  IF  (AR<2)  .LE.  1.)  NEWY  -  AR(2) 

0536  IF  (AR(2)  . GT .  1.)  NEWX  -  l./AR(2) 

0537  CALL  ZVIEW  ( 0  .  0 , NEWX, 0 . 0 ,NEWY ) 

0538  C 
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0539  9999  RETURN 

0540  END 

0541  END* 


t •»»  j|m* , 


4UK16N  T-00004  IS  ON  CR32767  USING  00013  BLKS  R=0086 
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0008 
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0012 
0013 
0014 
0015 
0016 
0017 
0018 
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0020 
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0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
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0  0  32 
0033 
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0035 
0  0  36 
0037 
0038 
0039 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
0050 
0051 
0052 
0053 
0054 
0055 
0056 
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FTN4,L 

C  24998-18466  REV. 2040  <810304.1057) 

c 

C  PROGRAH  WR16 

C 

C  DESCRIPTION: 

C  UR16  is  designed  to  obtain  nicrowave  Sll  neasurenents  at  different 
C  points  along  a  raster  scan  and  to  store  the  data  in  a  disc  file. 

C  This  progran  has  been  divided  into  four  segnents  because  it  cannot 

C  fit  into  nenory  otherwise.  The  nain  segment  always  remains  in 
C  memory.  Segment  WRi6C  is  the  control  segment,  which  is  the  first 

C  one  read  in  by  the  main  segment.  The  other  two  are  WR15G,  which 

C  plots  on  the  plotter  and  WRIST,  which  plots  on  the  terminal. 

C  UR16C  gives  the  user  a  choice  of  where  to  plot  for  each  run,  so 
C  essentially,  for  each  run  there  are  only  three  segments.  The 
C  two  segments  beside  the  moin  overlay  each  other  by  one  segment 
C  calling  EXEC<8,  other  segment  name)  to  read  in  the  other 
C  segment  over  the  calling  segment  and  then  pass  control  to  it. 

C  It  can  return  to  the  calling  segment  only  by  calling  EXEC(8, 

C  other  segment  name)  again. 

C  This  segment  is  the  main  segment.  It  is  run  by  typing  in: 

C  RU,UR16 

C  This  segment  only  defines  common,  initializes  variables,  and 
C  then  calls  EXEC<8,URi6C)  to  read  in  and  pass  control  to  segment 
C  UR16C. 

C  . 

C********1(**********tt****$***********************************************  1 

PROGRAH  UR16 
C 

DIMENSION  DAT<3,520),IPRNM(4),INAME<3) ,IDCB<144) ,NAMEF(3) , 

»  ISIZE<2),ITITL<40),PLUNIT(2) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNMjINAME, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREB, 

*  I AEND , TEMP  1 , TEMP2 , IRNUM , ESTEPS , lEEND , PRESEL , I DCB , NAMEF , 

»  ISIZE , IDONE , IPEND, ISEND , POSITN, IPFLAG , ILFLAG, ID, IDRCT , 

*  PLUNIT,ITITL,PRNT,FSTEPS,IFEND,IGRLOC 
C0MM0N/AGS2C/  DdO) 

IRNUM  -  1 
CRT  »  1 

IPRNM<1)  *  IHU 
IPRNM<2)  -  IHR 
IPRNM<3)  -  iHi 
IPRNM(4)  >  1H6 
IPRNL  -  4 
MESS  -  -1 
ASTEPS  -  5 
I AEND  «  4 
ESTEPS  -  30 
lEEND  =  3 

IPEND  -  1 
ISEND  -  1 
IDONE  -  0 
PRESAZ  =  999.9 
IPFLAG  =  1 
ILFLAG  =  1 
PLUNIT(l)  •:  4H  -  C 


% 


»  ■  ,  4  m"  «  •  ,  •  ,  *  «  ■  S  *  »_■  S,"  O  •»’  S"  "w*  *-*  * 


A*,*i*i*M*A* 


0  059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0068 
0069 
0070  C- 
0071  C 
0072  C- 
0073  C 
0074 
0075 
0076 
0077 
0078 
0079 
0080  C 
0081  C 
0082  C 
0083 
0084 
0085 
0086 


PLUNIT(2)  -  4HRT 
I6RL0C  -  1 
IFEND  -  1 
NAHEF<1)  >  2HSC 
NAHEF(2>  -  2HS1 
NAHEF(3)  ■  2Hlt 
PRNT  «  6 
CALL  F1LE2(1) 

TEMPI  -  D<1) 

TEHP2  -  (D<3)  -  1)  «  D<2)  •••  D(l> 
RFREQ  «  D<1) 


I 

I 

SL*’ 


Call  EXEC  to  road  in  soqnont  UR16C  and  pa*«  control  to  it. 


ICODE-S 

INAME<1)-2HUR 

1NAME<2)«2H16 

INAHE<3)-2HC 

CALL  EXEC  (I CODE,  I NAME) 
END 

Block  data  routino  for  AGS2C 

BLOCK  DATA  AGS2C 
COMMON  /AGS2C/  1(2330) 

END 

ENDf 


m 
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C 
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SEGMENT:  UR16C 


FDR  : 


Ualttr  Rccd  Arny  Institute  of  Research 
Department  of  Microwave  Research 
Walter  Rccd  Army  Medical  Center 
Washington,  DC  20112 


BY: 


Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone:  <301)  292-2592 


Segment  WR16C  is  the  control  segment  of  WR16.  It  puts 


out 

1 

2 

3 

4 

5 

6 
7 

10 


a  menu  with  the  options: 

-  Enter  the  number  of  azimuth  steps  and  step  size. 

-  Enter  the  number  of  elevation  steps  and  step  size. 

-  Enter  the  microwave  frequency. 

-  Set  antennae  to  a  new  azimuth  position. 

-  Set  antennae  to  a  new  elevation  position. 

-  Enter  number  of  readings  to  average  for  each  point. 

-  Request  graphs  on  the  CRT. 

-  List  on  the  printer. 

11  -  Enter  number  of  frequency  steps  and  step  size. 

8  -  Scan  from  the  present  position 

9  -  Terminate  the  program. 

After  8  is  chosen,  the  antennae  are  positioned  at  the 
present  position-<numbcr  of  data  points-1 Xstep  sizc/2. 
The  amplitude  and  phase  are  each  averaged  over  the  number 
of  readings  specified  in  6  and  saved  in  the  array  DAT 
aiong  with  the  position.  Then  the  antennae  are  advanced 
by  step  size  and  the  amplitude  and  phase  arc  read  again. 
This  is  repeated  for  the  specified  number  of  steps  per 
scan  . 

After  each  scan,  the  data  accumulotcd  in  array  DAT  is 
read  out  to  a  disc  file,  SCSllA.  If  there  is  a  fils 
with  that  name  already,  the  last  letter  is  incremented. 
After  the  data  is  read  out,  elevation  is  incremented  by 
elevation  step  size  and  the  whole  process  repeated  for 
the  number  of  elevation  steps. 


PROGRAM  WR16C,S 

DIMENSION  DAT(3,520),IPRNM(4),INAME<3) ,IDCB(144) ,NANEF<3) , 

*  ISIZE(2) ,ITITL(40) ,IR£G(2) ,1FAT(3120) ,PRNTL(2) , 

*  PLUNIT(2),FAT<1560),INA1S(3) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNM, INANE, CRT, IPRNL, MESS, ICODE,PRESAZ,ASTEPS,RFREQ 

*  I AEND, TEMP 1,TEMP2,IRNUN, ESTEPS, IEEND,PRESEL,IDCB,NAMEF, 

*  ISIZE , IDONE , IPEND, ISEND,POSITN , IPFLAG , ILFLAG , ID , IDRCT , 

*  PLUNIT,ITITL,PRNT,FSTEPS,  iFEND,IGRLOC 
EQUIVALENCE  < REG , IREG ) , ( DAT , IFAT ) , ( DAT , FAT ) 


C0MM0N/AGS2C/  D( 10 ) ,CAL<6, 112) ,Fi ,F2,F3,M1 ,M2,RP1 ,RP2, RP3,N0NLY 
»CH(4,112),IHEAD<40>,IDATE<15) 

DATA  LUAZ/31/,LUEL/3S/,I1/15446B/,INA1S/2HWR,2H15,2HT  / 


0  059 
0060 
0061 
0062 
0063 
0064 
0065 
0066 
0067 
0  068 
0069 
0070 
0071 
0072 
0073 
0074 
0075 
0076 
0077 
0078 
0079 
0080 
0081 
0082 
0083 
0084 
0085 
0086 
0087 
0088 
0089 
0090 
0091 
0092 
0093 
0094 
0  095 
0096 
0097 
0098 
0099 
0100 
0101 
0102 
0103 
0104 
0105 
0106 
0107 
0108 
0109 
0110 


C  S<t  nunbtr  of  scans  if  plots  roqussttd. 


If  start  of  progran,  go  to  n«nu. 

IF  (PRESAZ  .EQ.  999.9)  GO  TO  525 
If  graphing  on  scrocn>  do  not  list  data  there. 

IF  (IGRLOC  .EQ.  1)  ILFLA6  -  0 
If  finished  with  run,  go  reset  position. 

IF  (IDONE  .CE.  lEENO)  GO  TO  515 
If  plotting  every  scan,  go  do  next  scan. 

IF  (IPEND  .EQ.  1)  CO  TO  8701 
IF  (IDONE  .NE.  1)  GO  TO  511 
IF  (IPEND  .GT.  lEEND)  GO  TO  513 
Plotted  first  scan  so  now  get  back  on  schedule. 
ISEND  -  IPEND  -  1 
GO  TO  8701 

511  IF  (IDONE+IPEND  .GT.  lEEND)  GO  TO  513 
Plot  every  specified  scan. 

ISEND  -  IPEND 
GO  TO  8701 

Scan  to  end  of  run  without  plotting. 

513  ISEND  «  lEENO  -  IDONE 
IPFLAG  »  -1 
GO  TO  8701 


Reset  original  position. 


SIS  WRITE  (CRT,  519) 

519  FORMAT  (/,1X,«SCAN  IS  FINISHED* ,/, IX, 

*  "ANTENNAE  ARE  BEING  RESET  TO  THEIR  ORIGINAL  POSITION*, 

*  /, IX,  "PLEASE  EXCUSE  THE  DELAY") 

CALL  SETPO  (CRT,  LUAZ,  PRESAZ,  2,  lERR) 

IF  (lERR  .EQ,  0)  GO  TO  522 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

522  PRESEL  »  PRESEL  -  ESTEPS*( IEEND-1 ) 

CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

IF  (lERR  .EQ.  0)  GO  TO  523 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

C  Reset  paraneters  to  original  volues. 

523  IF  (IPFLAG  .EQ.  0)  GO  TO  525 
ISEND  «  1 
IPFLAG  -  1 
ILFLAC  »  1 

525  IDONE  »  0 

C - 

C  Clear  screen  and  print  heading  and  nenu. 


WRXTE(CRT,529) 

0529  FORMATC" 

*  10X,55'*',/» 

»1 OX, “*",20X, "PROGRAM  UR16* ,20X ,"**,/ , 

*10X, "**,15X, "521  RASTER  SCAN  PROGRAM* , 15X, "**,/ , 
*10X,55'*' ,/) 

530  CALL  UKl  (CRT,  LUAZ,  PRESAZ,  lERR,  0) 


•  •^*—'i***  -*»  »'«■>•»■>>■>  I 


I  •  j  '**1 


0119 

0120 

0121 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

0129 

0130 
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0132 

0133 
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0135 
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0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 

0157 

0158 

0159 

0160 

0161 

0162 

0163 

0164 

0165 

0166 

0167 

0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


IF  (lERR  .EQ.  0)  GO  TO  540 

CALL  VR12  (CRT,  lERR ,  .TRUE.,  0,  0,  IPRNN,  IPRNL) 
GO  TO  9090 

>40  CALL  URl  (CRT,LUEL,PRESEL,IERR,0> 

IF  (lERR  .£Q.  0>  GO  TO  550 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 
GO  TO  9090 

550  IF  (PRNT  .EQ.  0)  GO  TO  555 


PRNTL(l)  « 
PRNTL(2)  • 
GO  TO  560 
PRNTL(l)  = 
PRNTL(2)  > 


4H  PRI 
4HNT 

4HN0  P 
4HRINT 


UR1TE(CRT,600)  IAEND,ASTEPS, lEEND, ESTEPS ,RFREQ,PRESAZ 


PRESEL, 


*IRNUH, IPEND, (PLUNIT( I) , 1-1 ,2) , (PRNTL ( I ) , I-l ,2) , IFEND,FSTEPS 
0600  FORMATC  PROGRAH  PARAHETER  ENTRY", 30X, "PRESENT  VALUES",/, 

*"  1  -  Nunbcr  of  azinwth  steps  and  step  size . ", 

*13,"  *",F6.2,"  ««",/, 

«"  2  -  Nunber  of  elewotion  steps  and  step  size . ", 

*13,"  k",F6.2,"  m«",/, 

*"  3  -  Microwave  frequency . ", 

*F7.0,"  MHz",/, 

*"  4  -  Azinuth  position . . . . . ", 

*F8.3,"  ««",/, 

*"  5  -  Elevation  position . . . ", 

*F8.3,"  ««",/, 

*"  6  -  Nunber  of  readings  to  average  per  point . ",I5,/ 

*•  7  -  Nunber  of  scans  per  graphs . ",I5,i; 

*"  10  -  Toggle  switch  for  listing  on  printer . ",2X,2i 

*"  11  -  Nunber  of  frequency  steps  and  step  size . ", 

*13,"  x",FS.0,"  MHz",/, 

*"  EXECUTION  OPTIONS",/, 

*"  8  -  Scan  fron  the  present  position.",/, 

*“  9  -  Terninate  the  progran. ",/"") 

610  WRITE  (CRT, 619) 

C  Clear  old  pronpt  with  Esc  h  Esc  J. 

0619  FORMAT  ("") 

620  WRITE  (CRT, 629) 

629  FORMAT  (IX, "SELECT  OPTION  NUMBER  _") 

READ(CRT,«)  IANS 
IF  (IANS  .EQ.  9999)  CO  TO  9090 
IF  (IANS  .EQ.  10)  GO  TO  700 
IF  (IANS  .EQ.  11)  GO  TO  800 
IF  (IANS  .EQ.  9)  GO  TO  9090 

IF  (IANS  .EQ.  8)  GO  TO  8000 

IF  (IANS  .EQ.  7)  GO  TO  7000 

IF  (IANS  .EQ.  6)  GO  TO  6000 

IF  (IANS  .EQ.  5)  GO  TO  5000 


»I5,/, 

,I5,1X,2A4,/, 

,2X,2A4,/, 


IF  (IANS  .EQ. 
IF  (IANS  .EQ. 


4)  GO  TO  4000 
3)  GO  TO  3000 


IF  (IANS  .EQ.  2)  GO  TO  2000 
IF  (IANS  .EQ.  1)  GO  TO  1000 
WRITE  (CRT, 659) 

659  FORMAT  (/, IX, "ERROR  •  WR16  -  20001  . ( WR 16) " , / , IX , 

*  "INCORRECT  RESPONSE.  ENTER  ANY  NUNBER  FROM  1  TO  11, 

GO  TO  620 

C - 

C  Set  to  print  on  printer. 

C - 

700  IF  (PRNT  .EQ.  6)  GO  TO  750 
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750 


PKfi^X  ■  6 

PRNTLd)  >  4H  PRI 
PRNTL<2)  -  4HNT 
GO  TO  760 
PRNT  •  0 
PRNTLd)  -  4HN0  P 
PRNTL(2)  -  4HRINT 

760  WRITE  (CRT, 769)  II , (PRNTL< I ) , I-l ,2) 
769  FORMAT  dA2,  "a  54c  13Y",2A4) 

GO  TO  610 


C  Inquire  fren  user i  frequency  step  size  and  number  of  steps. 

C - 

800  WRITE  (CRT, 809) 

809  FORMAT  (/, IX , "Enter  the  number  of  frequency  steps.  *) 

READ  (CRT,*)  IFEND 

IF  (IFEND  .EQ.  9999)  GO  TO  9090 

IF  ((IFEND  .GT.  0)  .AND.  ( IFEND«(IAEND-i-l )  .LE.  520))  CO  TO  825 
WRITE  (CRT, 819) 

819  FORMAT  (/, IX, "ERROR  0  UR16  -  20002  . (WRi6)",/, 

«  IX, "NUMBER  OF  STEPS  MUST  BE  FROM  1  TO  520/ (AZIMUTH  STEPS  +  1).", 
*  /, IX, "REENTER  THE  NUMBER  OF  FREQUENCY  STEPS.*) 

GO  TO  800 

825  WRITE  (CRT, 829) 

829  FORMAT  (/, IX, "Enter  the  frequency  step  size  (MHz).  _") 

READ  (CRT,*)  FSTEP8 

IF  (FSTEP8  .EQ.  9999)  GO  TO  9090 

IF  ((RFREQt<IFEND-i)*FSTEPS)  .LE.  TEMP2)  GO  TO  SSO 
WRITE  (CRT, 3509)  TEMPI,  TEMP2 
READ  (CRT,  839)  IANS 

839  FORMAT  (A2) 

IF  (IANS  .EQ.  2HYE)  GO  TO  9000 
GO  TO  800 

850  WRITE  (CRT, 859)  II,  IFEND,  FSTEPS 

859  FORMAT  (1A2, "a  52c  14Y",I3,"  z",F5.0) 

GO  TO  610 


C  Inquire  from  the  user;  azimuth  step  size  and  number  of  steps. 

C - 

1000  WRirE(CRT,1100) 

1100  FORMAT(/,"  Enter  the  number  of  azimuth  steps  per  scan.  ") 
READ(CRT,*)  lAEND 
IF  (lAEND  .EQ.  9999)  GO  TO  9090 

IF  ( (IFEND*(IAEND+i)  .LE.  520)  .AND.  (lAEND  . GT .  0))  GO  TO  1190 
WRITE  (CRT, 1109) 

1109  FORMAT  (/, IX, "ERROR  ♦  WR16  -  20203  . (WR16)",/, 

*1X, "NUMBER  OF  STEPS  MUST  BE  FROM  1  TO  520/(FREQUENCY  STEPS)-!.",/, 
*  IX,  "REENTER  THE  NUMBER  OF  AZIMUTH  STEPS.") 

GO  TO  1000 

1190  WRITE(CRT,12Q0) 

1200  FORMAT(/,"  Enter  the  step  size  (mm) .  •) 

R£AD(CRT,*)  ASTEP3 
IF  (ASTEPS  .EQ.  9999)  GO  TO  9090 
WRITE  (CRT, 1209)  II , lAEND, ASTEPS 
1209  FORMAT  (lA2,*a  52c  6Y",I3,*  x",F6.2) 

GO  TO  610 


C  Inquire  from  user:  elevation  step  size  and  number  of  steps. 

C - 

2000  WRITE  (CRT, 2009) 
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2009  FORMAT  (/, IX, "Enter  the  nunber  of  tlcvation  steps.  *) 

READ  (CRT,«>  lEEND 
IF  (lEEND  .Ea.  9999)  GO  TO  9090 
IF  (lEENO  .CT.  0)  GO  TO  2028 
UNITE  (CRT, 2019) 

2019  FORMAT  </, IX, "ERROR  •  UR16  -  20404  . <WR16)",/, 

*  IX, "THE  NUMBER  OF  STEPS  MUST  BE  GREATER  THAN  0.",/, 

«  IX,  "REENTER  THE  NUMBER  OF  ELEVATION  STEPS.") 

CO  TO  2000 

2028  URITE  (CRT, 2029) 

2029  FORMAT  (/, IX, "Enter  the  elevation  step  size  (nn) .  ■) 

READ  (CRT,*)  ESTEPS 
IF  (ESTEPS  .EQ.9999)  GO  TO  9090 
WRITE  (CRT, 2039)  II,  lEEND,  ESTEPS 

2039  FORMAT  (lA2,"a  S2c  7Y",I3,-  x-,F6.2) 

GO  TO  610 

C - 

C  Inquire  fron  the  useri  nicrowave  frequency. 

C - 

3000  URITC(CRT,3500) 

3500  F0RMAT(/,"  Enter  the  RF  frequency  (MHz)...  •) 

READ(CRT,«)  RFREQ 

IF  (RFREQ  .EQ.  9999)  GO  TO  9090 

IF  ((RFREQ  .GE.  TEMPI)  .AND.  (RFREQ  .LE.  TEHP2) )  GO  TO  3600 
WRITE  (CRT, 3509)  TEMPI,  TEMP2 

3509  FORMAT  (/, IX, "ERROR  *  UR16  -  20005  . ( UR16 ) " ,/ , IX, 

*  "CALIBRATION  ONLY  FROM  ",F6.0,"MHz  TO  " ,F6. 0 , "MHz . " , 

»  /, IX, "FREQUENCY  MUST  BE  BETWEEN  CALIBRATION  LIMITS.-, 

*  /,lX,"Do  you  wish  to  recalibrate?  (YES/NO)  ") 

READ  (CRT, 3599)  IANS 

3599  FORMAT  (A2) 

IF  (IANS  .EQ.  2HYE)  GO  TO  9000 
GO  TO  3000 

3600  URITE  (CRT,  3609)  11,  RFREQ 

3609  FORMAT  (lA2,"a  54c  8Y",F5.0> 

GO  TO  610 

C - 

C  Inquire  new  azinuth  position  and  call  WR6  to  set  it. 

C - 

4000  WRITE  (CRT, 4090) 

4090  FORMAT  (/, IX, "Enter  new  azinuth  (mm).  ") 

READ  (CRT,*)  PRESAZ 

IF  (PRESAZ  .EQ.  9999)  GO  TO  9090 

CALL  SETPO  (CRT, LUAZ, PRESAZ, 2, lERR) 

IF  (lERR  .EQ.  0)  GO  TO  4400 

CALL  WR12  ( CRT, lERR, .TRUE. ,0,0, IPRNM,IPRNL) 

GO  TO  620 

4400  WRITE  (CRT, 4409)  II, PRESAZ 

4409  FORMAT  (iA2,"a  52c  9Y-,F8.3) 

CO  TO  610 

C - 

C  Inquire  new  elevation  and  call  UR6  to  set  it. 

C - 

5000  WRITE  (CRT, 5090) 

5090  FORMAT  (/, IX, "Enter  new  elevation  ") 

READ  (CRT,*)  PRESEL 

IF  (PRESEL  .EQ.  9999)  GO  TO  9090 

CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

IF  (lERR  .EQ.  0)  CO  TO  5500 

CALL  WRi2  (CRT, lERR, .TRUE. ,0,0, IPRNM,IPRNL) 
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GO  TO  620 

5500  URITE  (CRT, 5509)  II,  PRESCL 
5509  FORMAT  <lA2,"a  52c  t0Y«,F8.3) 

GO  TO  610 

C - 

C  Inquire  fron  the  usert  nunber  of  readings  per  data  point. 

C - 

6000  URITE  (CRT, 6009) 

6009  FORMAT  (/,iX, 

9  "Enter  nunber  of  readings  to  average  per  data  point.  _*> 

READ  (CRT,*)  IRNUH 
IF  (IRNUH  .EQ.  9999)  GO  TO  9090 

IF  ((IRNUH  .LE.  32767)  .AND.  (IRNUH  .CT.  0))  CO  TO  6600 
URITE  (CRT, 6509) 

6509  FORMAT  (/, IX, "ERROR  *  UR16  -  20006  . (UR16)",/, 

«  IX, "NUMBER  TO  AVERAGE  MUST  BE  FRON  1  -  32767.",/, 

«  IX, "REENTER  NUHBER  OF  READINGS  TO  AVERAGE  PER  POINT.*) 

CO  TO  6000 

6600  URITE  (CRT,  6609)  II,  IRNUH 
6609  FORMAT  (lA2,"a  52c  11Y",I5) 

GO  TO  610 

C - 

C  Inquire  fron  user:  nunber  of  scans  per  graph. 

C - 

7000  URITE  (CRT, 7009) 

7009  FORMAT  (/, IX, "Enter  nunber  of  scans  between  graphs  on  screen.  _") 
READ  (CRT,*)  IPENO 
IF  (IPEND  .EQ.  9999)  GO  TO  9090 
IF  (IPEND  ,GE,  0)  GO  TO  7500 
URITE  (CRT, 7209) 

7209  FORMAT  (/, IX, "ERROR  ♦  UR16  -  20007  . (UR16)",/, 

*  IX, "NUMBER  OF  SCANS  CAN  NOT  BE  LESS  THAN  0*,/, 

«  IX, "REENTER  NUMBER  OF  SCANS  BETUEEN  GRAPHS  ON  CRT.") 

GO  TO  7000 

7500  URITE  (CRT, 7509) 

7509  FORMAT  (/, IX, “Enter  '1'  to  plot  on  CRT  or  '0'  to  plot  on  ", 

*  "plotter.  ") 

READ  (CRT,*)  IGRLOC 
IPFLAG  »  1 

PLUNIT(l)  »  4H-PL0 
PLUNIT(2)  »  4HTTER 
IF  (IGRLOC  .NE,  1)  GO  TO  7550 
PLUNIT(l)  »  4H  -  C 
PLUNIT(2)  «  4HRT 

7550  IF  (IPEND  . NE .  0)  GO  TO  7600 
IPFLAG  -  0 
PLUNIT(l)  =  4HGRAP 
PLUNIT(2)  =  4HHS 
7600  ISEND  -  1 

URITE  (CRT,  7609)  II,  IPEND,  ( PLUNIT( I ) , I-l , 2) 

7609  FORMAT  (lA2,"a  52c  12Y " , 15, IX , 2A4) 

GO  TO  610 


C  Set  antennae  to  first  position  and  create  disc  data  file. 

C - 

C  Find  title  for  file. 

0000  URITE  (CRT, 8009)  ( ITITL ( 1 ) , I-l , 40 ) 

8009  FORMAT  (/,1X, 

♦"Enter  title  of  file  or  press  'RETURN'  key  for  following  title.*, 
*/,40A2,/) 
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C  Blank  out  rtst  of  80  bytes  of  title. 

REG  »  EXEC  (l,401B,ITITL,-80> 

IF  <IRE6(2)  .EQ.  0)  CO  TO  8100 
IF  (IREC(2)  .GT.  78)  GO  TO  8060 
DO  8050  I  >  (IREC(2)t3)/2,40 
8050  ITITL(l)  ■  2H 

8060  IF  ( (IREG<2)/2)«2  .EQ.  IREC(2))  CO  TO  8100 

ITITL(IREC(2)/2tl)  -  ( ITITL(  IREG  (2) /2-i-l ) /256>«2S6  ♦  32 
C  Set  ozinuth  to  -<l/2  of  scan). 

8100  POSITN  >  PRESAZ-ASTEPS«(IAEND-l)/2 
PARAH  «  POSITN 
CALL  UR6<PARAM,IERR,2,0) 

IF  (lERR  .EQ.O)  CO  TO  8200 

CALL  UR12(CRT,IERR, .TRUE. , 0 , 0 , IPRNM, IPRNL) 

GO  TO  620 
8200  D(3)  -  1 

C  Record  size  *  3  double  words  B  <steps  in  scan  *  1). 

ISIZE(2)  -  6  «  (lAEND  +  1) 

C  Hininun  record  size  >  128. 

IF  <ISIZE<2)  .LT.  128)  ISIZE(2)  -  128 
C  File  size  «  record  size  «  (elevation  steps  «  frequency  steps  1). 

ISIZE(l)  =  <IS1ZE(2)  *  (lEEND  «  IFEND  ♦  1)  ♦  127)/128 
8300  NANEF<3)  -  NANEF<3)  *  1 

CALL  CREAT  < IDCB, lERR ,NAHEF, ISIZE,2) 

IF  (lERR  .GE.  0)  GO  TO  8450 
IF  (lERR  .EQ.  -2)  GO  TO  8300 
WRITE  (CRT, 8409)  lERR 

8409  FORMAT  (/, IX, "ERROR  #",13,"  OCCURED  IN  SUBROUTINE  CREAT") 

CO  TO  9090 

8450  IF  (PRNT  .EQ.  0)  GO  TO  8500 
C  Print  title  ond  nenu  on  line  printer. 

WRITE  (PRNT, 8459)  ( ITITL( I ) , I«i , 40 ) , (NAMEF( I ) , 1*1 , 3) 

8459  FORMAT  ( "1 " ,40A2,/ , IX , "FILE  ■  ■,3A2) 

WRITE  (PRNT, 600)  lAEND ,ASTEPS, lEEND , ESTEPS ,RFREQ, PRESAZ,PRESEL , 
«  IRNUM, IPEND , PLUNIT , PRNTL , IFEND , FSTEPS 

8500  WRITE  (CRT, 8509)  NAHEF 

8509  FORMAT  (/,1X,"NAME  OF  DATA  FILE  IS  ■,3A2) 

C  Pot  specifications  in  first  record. 

CALL  FTIME(IFAT) 

DO  8550  1-1,40 
8550  IFAT(15+I)  -  ITITL(I) 

1FAT(56)  -  2HEL 
IFAT(57)  -  0 
IFAT(58)  -  lAEND 
FAT(30)  -  ASTEPS 
IFAT<61)  -  0 
IFAT(62)  -  lEEND 
FAT(32)  -  ESTEPS 
FAT(33)  -  RFREQ 
IFAT(67)  »  ISIZE(l) 

IFAT(68)  -  ISIZE(2) 

IFAT<69)  -  0 
IFAT(70)  -  IKLND 
FAT(36)  -  FSTEPS 
ILFLAG  -  1 

CALL  WRITF  (IDCB,  lERR,  FAT) 

IF  (lERR  .EQ.  0)  GO  TO  8700 
WRITE  (CRT, 8609)  lERR 

8609  FORMAT  (/, IX, "ERROR  ♦  ",13,"  OCCURED  IN  SUBROUTINE  WRITF") 

GO  rO  9090 
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C  Elcvotion  scan  fron  PRESEL  to  PRESEL+ESTEPS»< IEEND-1 )  or  until  graph  ncodod. 

- - 

8700  IF  (IPEND  .EQ.  0)  ISENO  -  lEEND 
ID  >  1 

IDRCT  >  1 

8701  DO  8900  J«1,1SEND 

IF  (J  IDONE  .EQ.  1)  GO  TO  8720 
C  If  not  first  scan,  switch  direction  and  incrensnt  slsvotion. 

IDRCT  ■  -IDRCT 

PRESEL  -  PRESEL  ♦  ESTEPS 

PARAH  >  PRESEL 

CALL  UR6  <PARAH,  lERR,  4,  1) 

IF  (lERR  .EQ.  0)  GO  TO  8720 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

8720  CALL  URl  (CRT,  LUEL,  TRUEL,  lERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8725 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

C - 

C  Azinoth  scan  fron  PRESAZ-ASTEPS*( IAEND-1 )/2  to  PRESAZ+ASTEPS*( I AEND-1 )/2 

- - 

8725  DO  8800  I»i,IAEND 
C  If  break  flag  set,  go  back  to  nenu. 

IF  (IFBRK(IERR))  523,8730 

8730  CALL  URl  (CRT,  LUAZ,  TRUAZ,  lERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8735 

CALL  UR12  (CRT,  lERR ,  .TRUE.,  0,0,  IPRNH,  IPRNL) 

GO  TO  9090 

C  Do  frequency  scan  at  each  position. 

8735  DO  8790  L»0,1FEND-1 

D(l)  =  RFREQ  +L4FSTEPS 
YAVE  »  0. 

XAUE  =  0. 

C  Loop  for  statistical  averaging. 

DO  8750  K  >  1,1RNUH 
CALL  C0RS5( 1,4,1) 

CALL  CP0L2(CH(1,1),X,Y) 

YAVE  =»  YAVE  ♦  Y 

8750  XAVE  «  XAVE  *  X 
XAVE  -  XAVE  /  IRNUM 
YAVE  ■  YAVE  /  IRNUH 
RLOSS  — 10«ALOGT(XAVE»*2) 

IF  (ILFLAG  .EQ.O)  GO  TO  8780 

WRITE  (CRT, 8779)  D ( 1 ), TRUAZ , RLOSS, YAVE 

8779  FORHAT  (IX, "FREQ  -",F6. 0,5X, "AZIMUTH  -•,F8.3,SX, 

*  "RLOSS  »",F9.4,5X,"PHASE  »",F8.3) 

8780  IL  =>  ID  >  L  «  (lAEND  +  1) 

DAT  (1.  ID  =  TRUAZ 


DAT(1,IL) 
DAT(2,IL) 
DAT(3,IL) 
8790  CONTINUE 
IF  (I  .GE 


RLOSS 

YAVE 


IF  (I  .GE.  lAEND)  GO  TO  8800 
ID  =  ID  +  IDRCT 

POSITN  -  POSITN  ♦  IDRCT  *  ASTEPS 

PARAH  =  POSITN 

CALL  UR6(PARAM,IEKR,2,0) 

IF  (lERR  .EQ.O)  GO  TO  8800 

CALL  UK12<CRT, lERR, .TRUE. , 0 , 0 , IPRNH, IPRNL) 
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GO  TO  9090 
8800  CONTINUE 


C  End 
C - 


of  aziniuth  scan  loop. 


IF  (PRNT  .EQ.  0)  CO  TO  8830 
WRITE  (PRNT, 8829)  TRUEL 
FORMAT  <//,5X,-ELEVAriON  •-,F8.3> 

DO  8890  L  >  1,  IFEND 

ILB  -  1  +  (L  -1)  «  (lAENO  ♦  1) 

ILE  -  L  »  (lAEND  ♦  1) 

DAT(1,ILE>  ■  TRUEL 

DAT<2,ILE)  -  RFRE8  +  (L  -  1)  *  FSTEPS 
IF  (PRNT  .EQ.  0)  GO  TO  8850 
DO  8840  IE  >  ILB, ILE  -  1 

WRITE  (PRNT,  8849)  DAT(2,ILE),  (DAT( I , IE ) , I-l , 3) 

FORMAT  (IX, "FREQ  ■■ ,F6 . 0 ,5X, "AZIM  -■,F8.3, 
t  5X,'RL0SS  -•,F8.3,5X,*PHASE  -",F8.3) 

CALL  WRITF  ( IDCB, lERR ,DAT( 1 , ILB) ) 

IF  (lERR  .EQ.  0)  GO  TO  8890 
WRITE  (CRT, 8859)  lERR 

FORMAT  (/, IX, “ERROR  ♦  “,I3,*  OCCURED  IN  SUBROUTINE  WRITF") 
GO  TO  9090 
CONTINUE 
CONTINUE 


C  End  of  elevation  scan  loop 

C - 

IDONE  -  lOONE  *  ISEND 

C  If  no  scans,  qo  to  reset  oriqinal  position. 
IF  (IPFLAG  .LT.  1)  GO  TO  515 


C  Call  EXEC  to  overlay  this  segnent  with  WR16C 

C - 

8990  IF  (IGRLOC  .EQ.  1)  GO  TO  8995 
INA15(3)  3  2HG 
GO  TO  8998 
8995  INAi5(3)  -  2HT 
8998  CALL  EXEC  ( ICODE , INAi5) 

9000  WRITE  (CRT, 9009) 

9009  FORMAT  (2/, IX, "Ron  program  ACS02  for  new  calibration.") 
9090  WRITE  (CRT, 9099) 

09099  FORMAT  (/,10X, 

*"»««««««»««  PROGRAM  WR16  TERMINATED  *««»*»»«««■) 

CALL  CLOSE  (IDCB) 

END 


Subroutine  SETPO  calls  WR6  to  set  an  azinuth  or  elevation  position 
and  then  calls  WRl  to  check  the  position.  If  it  is  within  .002  it 
returns,  if  not  it  calls  WR6  once  ogain. 

SUBROUTINE  SETPO( CRT ,LU, PRES, UNIT , lERR ) 

DO  100  I  1,2 
PARAM  >  PRES 

CALL  WR6  (PARAM, lERR, UNIT, 0) 

IF  (lERR  .NE.  0)  RETURN 
IF  (I  .GT,  1)  RETURN 
IF  (LU  .EQ.  33)  GO  TO  90 
CALL  WWl  <CRT,L!  IEW,IERR,0) 

GO  TO  91 

-  173- 


&UK17N  T-00a04  IS  ON  CK32767  USING  00013  BLKS  R>0086 


0001  FTN4,L 

0002  C  24998-18466  REU.2040  <810304.1057) 

0003  Ct************************************************************************ 

0004  C 

0005  C  PROGRAM  WR17 

0006  C 

0007  C  DESCRIPTION) 

0008  C  UR17  is  designed  to  obtain  nicrowawe  Sll  neasurenents  at  different 
0009  C  points  along  a  raster  scon  and  to  store  the  data  in  a  disc  file. 

0010  C  This  progran  hos  been  divided  into  four  segnents  because  it  cannot 

0011  C  fit  into  nenory  otherwise.  The  noin  segnent  alwoys  renoins  in 
0012  C  nenory.  Segnent  WR17C  is  the  control  segnent,  which  is  the  first 

0013  C  one  read  in  by  the  noin  segnent.  The  other  two  are  UR15G,  which 

0014  C  plots  on  the  plotter  and  WR15T,  which  plots  on  the  terninal . 

0015  C  UR17C  gives  the  user  o  choice  of  where  to  plot  for  each  run,  so 
0016  C  essentially,  for  each  run  there  ore  only  three  segnents.  The 
0017  C  .wo  segnents  beside  the  nain  overlay  eoch  other  by  one  segnent 

0018  C  calling  EXEC(8,  other  segnent  none)  to  reod  in  the  other 

0019  C  segnent  over  the  calling  segnent  and  then  poss  control  to  it. 

0020  C  It  can  return  to  the  calling  segnent  only  by  calling  EXEC(8, 

0021  C  other  segnent  nane)  again. 

0022  C  This  segnent  is  the  nain  segnent.  It  is  run  by  typing  in) 

0023  C  RU,UR17 

0024  C  This  segnent  only  defines  connon,  initializes  variables,  and 
0025  C  then  calls  EXEC(8,URi7C)  to  read  in  and  pass  control  to  segnent 
0026  C  URi7C. 

0027  C 

0028  C************************************************************************* 

0029  C 

0030  PROGRAM  WR17 

0031  C 

0032  DIMENSION  DAT < 3, 520 ) , IPRNN< 4 ) , INAME ( 3 ) , IDCB< 144 ) , NAMEF (3 ) , 

0033  *  IS1ZE(2),ITITL(40),PLUNIT(2),IDUM(25> 

0034  INTEGER  CRT,PRNT 

0035  COMMON  DAT , IPRNM , INAME , CRT , IPRNL , MESS , ICODE , PRESAZ , ASTEPS ,RFREq , 

0036  *  lAEND, TEMPI, T£MP2,1RNUM, ESTEPS, IEEND,PRESEL,IDCB, NAMEF, 

0037  *  ISIZE,IDONE,IPEND,ISEND,POSITN,IPFLAG,ILFLAC,ID,IDRCT, 

0038  «  PLUNIT,lTITL,PRNT,FSTEPS,IFEND,ICRLOC 

0039  C0MM0N/AGS2C/  D<10) 

0040  IRNUM  -  1 

0041  CRT  -  1 

0042  IPRNMd)  >  IHU 

0043  IPRNM<2)  «  IHR 

0044  IPRNM(3)  *  IHl 

0045  IPRNM<4)  •  1H7 

0046  IPRNL  «  4 

0047  MESS  -  -1 

0048  ASTEPS  >  5 

0049  lAEND  -  4 

0050  ESTEPS  -  30 

0051  lEEND  -  3 

0052  IPEND  =•  1 

0053  ISEND  >  1 

0054  IDONE  «  0 

0055  PRESAZ  -  999.9 

0056  IPFLAG  «  1 

0057  ILFLAG  »  1 

0058  PLUNITd)  ■  4H  -  C 


0059  PLUNIT<2)  -  4HRT 

0060  IGRLOC  «  1 

0061  IFEND  -  i 

0062  NAMEF<i)  -  2HSC 

0063  NAMEF(2)  -  2HS1 

0064  NAHEF(3)  -  2H19 

0065  PRNT  -  6 

0066  CALL  FILE2(1) 

0067  RFREQ  -  D<1) 

0068  FSTEPS  -  0<2) 

0069  IFEND  -  D(3) 

0070  C - 

0071  C  Call  EXEC  to  road  in  scgnont  UR17C  and  pas*  control  to  it. 

0072  C - 

0073  C 

0074  I CODE-8 

0075  INAHE<1)-2HWR 

0076  INAME(2)-2Hi7 

0077  INAHE<3)«2HC 

0078  CALL  EXEC  (ICODE,  INANE) 

0079  END 

0080  C 

0081  C  Block  data  routine  for  AGS2C 
0082  C 

0083  BLOCK  DATA  AGS2C 

0084  COMMON  /AGS2C/  1(2330) 

0085  END 

0086  ENOO 


i 


s.* 

O 
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SEGHENTi  URi7C 

++++++++++++++++++++++++-f++++++++++++++ 

FOR  I  Walter  Reed  Arny  Institute  of  Research 

Departnent  of  Microwave  Research  i 

Walter  Reed  Arny  Medical  Center  > 

Washington,  DC  20112 


Technology  USA,  Inc. 

P.O.  Box  55333 

Fort  Washington,  Maryland  20744 
Phone*  (301)  292-2592 


t  Segnent  URi7C  is  the  control  segnent  of  WR17.  It  puts  « 

4  out  a  Menu  with  the  options:  * 

4  1  -  Enter  the  nunber  of  azinuth  steps  and  step  size.  • 

*  2  -  Enter  the  nunber  of  elevation  steps  and  step  size.  * 

*  3  -  Enter  subtraction  file  nane.  * 

*  4  -  Set  antennoe  to  a  new  azinuth  position.  * 

«  5  -  Set  antennae  to  a  new  elevation  position.  « 

*  6  -  Enter  nunber  of  readings  to  average  for  eoch  point.  * 

*  7  -  Request  graphs  on  the  CRT.  * 

*  10  -  List  on  the  printer.  » 

»  8  -  Scan  fron  the  present  position  « 

*  9  -  Terninate  the  proqran.  « 

*  After  8  is  chosen,  the  antennae  are  positioned  ot  the  * 

*  present  position-<nunber  of  data  points-1 )*step  size/2.  0 

*  The  anplitude  and  phase  are  converted  to  conplcx  * 

*  conponents,  the  corresponding  conponents  fron  the  S 

*  subtraction  file  deducted,  and  the  results  are  saved  in  « 

0  the  array  DAT  along  with  the  position.  Then  the  antennae  * 
0  are  advanced  by  step  size  and  the  anplitude  and  phase  are  * 
«  read  again.  This  is  repeated  for  the  specified  nunber  of  t 
«  steps  per  scan.  « 

*  After  each  scan,  the  dato  accunulated  in  array  DAT  is  * 

«  read  tut  to  a  disc  file,  5CS11A.  If  there  is  o  file  « 

t  with  that  nane  already,  the  last  letter  is  increnented.  * 

0  After  the  data  is  read  out,  elevation  is  increnented  by  t 

*  elevation  step  size  and  the  whole  process  repeated  for  t 

*  the  nunber  of  elevation  steps.  t 

*  * 
****$****$*************$*****************$**$***************** 

PROGRAM  WR17C,5 

IIMENSION  DAT(3,520),IPRNM(4),INAME<3),IDCB<i44) ,NAMEF<3) , 

*  ISIZ£<2) ,ITITL(40) ,IREG(2) , IFAT ( 3120 ) ,PRNTL ( 2)  , 

*  PLUNIT(2) ,FAT(1560),1NA15(3) ,SAT(2,15) ,INSUB<3) 

INTEGER  CRT,PRNT 

COMMON  DAT, IPRNM,INAME,CRT,IPRNL,MESS,ICODE,PRESAZ,ASTEPS,RFREQ, 

*  •  lAEND, TEMPI ,TEMP2,IHNUM, ESTEPS, XEEND,PRESEL,IDCB,NAMEF, 

*  ISIZE, IDONE, IPEND,ISEND,POSITN,IPFLAG,ILFLAG,ID,IDRCT, 

*  PLUNIT, ITITL,PRNT,KSTEPS, IFEND,IGRLOC 
EQUIVALENCE  (KEG,IREG) , (DAT, IFAT ), (DAT, FAT) 
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005?  C 

0060  C0MM0N/AGS2C/  D< 10 ) ,CAL(6, 112) ,F1 ,F2 ,F3, Ml ,M2 ,RPl ,RP2 ,RP3 ,NONLY, 

0061  «CM(4,112) ,IHEAD(40),IDATE<15) 

0062  DATA  LUAZ/31/,LUEL/35/, I1/1S446B/,INA15/2HUR,2H15,2HT  /, 

0063  41NSUB/2H0  >2H  ,2H  / 

0064  C - 

0065  C  Sat  nunbcr  of  scanm  if  plots  roquostod. 

0  066  C - 

0067  C  If  start  of  progran,  go  to  nonu. 

0068  IF  <PRESAZ  .EQ.  999.9)  GO  TO  525 

0069  C  If  graphing  on  scrocn,  do  not  list  data  thort. 

0070  IF  (IGRLOC  .El).  1)  ILFLAG  -  0 

0071  C  If  finished  with  run,  go  reset  position. 

0072  IF  <IOONC  .GE.  lEENO)  CO  TO  515 

0073  C  If  plotting  every  scan,  go  do  next  scan. 

0074  IF  (IPEND  .EQ.  1)  GO  TO  8701 

0075  IF  <IDONE  .NE.  1)  GO  TO  511 

0076  IF  (IPEND  .GT.  lEEND)  GO  TO  513 

0077  C  Plotted  first  scan  so  now  get  back  on  schedule. 

0078  ISEND  a  IPEND  -  1 

0079  GO  TO  8701 

0080  511  IF  (IDONE+IPEND  .GT.  lEEND)  GO  TO  513 

0081  C  Plot  every  specified  scan. 

0082  ISEND  «  IPEND 

0083  GO  TO  8701 

0084  C  Scan  to  end  of  run  without  plotting. 

0085  513  ISEND  =  lEEND  -  IDONE 

0086  IPFLAG  =  -1 

0087  GO  TO  8701 

0088  C - 

0089  C  Reset  original  position. 

0090  C - 

0091  515  WRITE  (CRT,  519) 

0092  519  FORMAT  (/,1X,"SCAN  IS  FINISHED" ,/, IX , 

0073  «  "ANTENNAE  ARE  BEING  RESET  TO  THEIR  ORIGINAL  POSITION", 

0094  «  /,iX, “PLEASE  EXCUSE  THE  DELAY") 

0095  CALL  SETPO  (CRT,  LUAZ,  PRESAZ,  2,  lERR) 

0096  IF  (lERR  . EQ .  0)  GO  TO  522 

0097  CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

0098  GO  TO  9090 

0099  522  PRESEL  =  PRESEL  -  ESTEPS*< IEEND-1 ) 

0100  CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

0101  IF  (lERR  .EQ.  0)  GO  TO  523 

0102  CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

0103  GO  TO  9090 

0104  C  Reset  poraneters  to  original  values. 

0105  523  IF  (IPFLAG  . EQ .  0)  GO  TO  525 

0106  ISEND  =  1 

0107  IPFLAG  -  1 

0108  ILFLAG  »  1 

0109  525  IDONE  =  0 

0110  C - 

0111  C  Clear  screen  and  print  heading  and  nenu. 

0112  C - 

0113  WRITE(CRT,529) 

0114  0529  F0RMAT(“" 

0115  *  10X,S5'*',/, 

0116  *10X, "#“,20X, "PROGRAM  WR17" ,20X , 

0117  *10X, "*",1SX, "Sll  RASTER  SCAN  PROGRAM" , 15X , 

0118  *10X,55'**  ,/) 
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0119 

0120 

0121 

0122 

0123 

0124 

012S 

0126 

0127 

0128 

0129 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 

0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 


0168 

0169 

0170 

0171 

0172 

0173 

0174 

0175 

0176 

0177 

0178 


530 


540 


0,  IPRNM,  IPRNL) 


CALL  URl  (CRT,  LUAZ,  PRESAZ,  lERR,  0) 

IF  (lERR  .EQ.  0)  CO  TO  540 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0, 

GO  TO  9090 

CALL  URl  (CRT,LUEL,PRESEL,IERR,0> 

IF  (lERR  .EQ.  0)  CO  TO  550 

CALL  UR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 
GO  TO  9090 

0)  GO  TO  555 
4H  PRI 
4HNT 


550  IF  (PRNT  .EQ 
PRNTL(i)  * 
PRNTL(2)  « 
GO  TO  560 
PRNTL(l)  » 
PRNTL(2)  » 


555 


4HNO  P 
4HRINT 

560  URITE(CRT,600)  lAEND,  ASTEPS,  lEEND,  ESTEPS,  INSUB,  PRESAZ, 

*  PRESEL,  IRNUH,  IPEND,  PLUNIT,  PRNTL 

0600  FORMATC  PROGRAH  PARAMETER  ENTRY', 30X, "PRESENT  VALUES",/, 

*"  1  -  Nufiber  of  azinuth  steps  and  step  size.. 

*13,"  x",F6.2,"  MM",/, 

*■  2  -  NuMber  of  elevation  steps  and  step  size 

*13,"  k",F6.2,*  mm",/, 

*"  3  -  Subtraction  file  none . ",2X,3A2,/, 

t"  4  -  AziMuth  position.. 

*F8.3,'  MM",/, 

**  5  -  Elevation  position 

*F8.3,"  MM",/, 


« 

« 

« 

* 

« 

« 


6  -  NuMber  of  readings  to  overage  per  point, 

7  -  NuMber  of  scans  per  graphs . . . 

10  -  Toggle  switch  for  listing  on  printer..., 

EXECUTION  OPTIONS",/, 

8  -  Scan  froM  the  present  position.",/, 

9  -  TerMinate  the  progroM. ",/"') 

610  URITE  (CRT, 619) 

C  Clear  old  proMpt  with  Esc  h  Esc  J. 

619  FORMAT  ("") 

620  URITE  (CRT, 629) 

629  FORMAT  (IX, "SELECT  OPTION  NUMBER 
READ(CRT,*)  IANS 


IS,/, 

15,iX,2A4,/, 

2X,2A4,/, 


') 


0157 

IF 

( IANS 

.EQ. 

9999) 

GO 

TO  9 

0158 

IF 

(IANS 

.EQ. 

10) 

GO  TO  700 

0159 

IF 

( IANS 

.EQ. 

9) 

GO 

TO 

9090 

0160 

IF 

(IANS 

.EQ. 

8) 

GO 

TO 

8000 

0161 

IF 

(IANS 

.EQ. 

7) 

GO 

TO 

7000 

0162 

IF 

(IANS 

.EQ. 

6) 

GO 

TO 

6000 

0163 

IF 

(  IANS 

.EQ. 

5) 

CO 

TO 

5000 

0164 

IF 

(IANS 

.EQ. 

4) 

GO 

TO 

4000 

0165 

IF 

( IANS 

.EQ. 

3) 

GO 

TO 

3000 

0166 

IF 

(IANS 

.EQ. 

2) 

GO 

TO 

2000 

0167 

IF 

(IANS 

.EQ. 

1) 

GO 

TO 

1000 

WRITE  (CRT, 659) 

659  FORMAT  (/, IX ,  "ERROR  ♦  UR17  -  21001  . (HR17) ' ,/, IX  , 

♦'INCORRECT  RESPONSE.  ENTER  ANY  NUMBER  FROM  1  TO  10.") 
GO  TO  620 


C- 

C 

C- 


Set  to  print  on  printer. 


700  IF  (PRNT  .EQ.  6)  GO  TO  750 

ppiJT  s  A 

PRNTL(i)  =  4H  PRI 
PRNTL(2)  =  4HNT 

-  J79- 


n  n 

P 


a 


-M 


"Cl 


3 


0179  GO  ro  760 

0180  750  PKNT  »  0 

0181  PRNTL(l)  -  4HNQ  P 

0182  PRNTL<2)  -  4HRINT 

0183  760  WRITE  (CRT, 769)  II , (PRNTL< I ) , 1=1 ,2) 

0184  769  FORMAT  <1A2,  "a  54c  i3Y“,2A4) 

0185  GO  TO  610 

0186  C - 

0187  C  Inquire  fron  user:  frequency  step  size  and  nynber  of  steps. 

0188  c— 

0189  C  800  WRITE  (CRT, 809) 

0190  C  809  FORMAT  (/, IX, "Enter  the  nunber  of  frequency  steps.  ") 

0191  C  READ  (CRT,*)  IFEND 

0192  C  IF  (IFEND  .EQ.  9999)  GO  TO  9090 

0193  C  IF  ( (IFEND«(IAEND+1)  .LE.  520)  .AND.  (IFEND  .CT.  0))  GO  TO  825 

0194  C  WRITE  (CRT, 819) 

0195  C  819  FORMAT  (/, IX, "ERROR  •  UR17  -  21002  . (WRi7)",/, 

0196  C  *•  THE  NUMBER  OF  STEPS  MUST  BE  FROM  1  TO  520/( AZIMUTH  STEPS  ♦  1).“, 

0197  C  «  /, IX, "REENTER  THE  NUMBER  OF  FREQUENCY  STEPS.") 

0198  C  GO  TO  800 

0199  C  825  WRITE  (CRT, 829) 

0200  C  829  FORMAT  (/, IX, "Enter  the  frequency  step  size  (MHz).  ") 

0201  C  READ  (CRT,*)  FSTEPS 

0202  C  IF  (FSTEPS  ,EQ.  9999)  GO  TO  9090 

0203  C  IF  ( (I^FREQt(IFEND-i)*FSTEPS)  .LE.  TEMP2)  GO  TO  850 
0204  C  WRITE  (CRT, 3509)  TEMPI,  TEMP2 

0205  C  READ  (CRT,  839)  IANS 

0206  C  839  FORMAT  (A2) 

0207  C  IF  (IANS  .EQ.  2HYE)  CO  TO  9000 
0208  C  GO  TO  800 

0209  C  850  WRITE  (CRT, 859)  II,  IFEND,  FSTEPS 
0210  C  859  FORMAT  (lA2,"a  52c  14Y",I3,"  x",F5,0) 

0211  C  GO  TO  610 

0212  C - 

0213  C  Inquire  fron  the  user:  azinuth  step  size  and  nunber  of  steps. 

0214  C - - - 

0215  1000  WRXTE(CRT,1100) 

0216  1100  FORMAT(/,"  Enter  the  nuHber  of  azinuth  steps  per  scan.  _") 

0217  READ(CRT,*)  lAEND 

0218  IF  (lAEND  .EQ,  9999)  GO  TO  9090 

0219  IF  ( (IFEND*(IAEND+1)  .LE.  520)  .AND.  (lAEND  . GT .  0))  GO  TO  1190 

0220  WRITE  (CRT, 1109) 

0221  1109  FORMAT  (/,"  ERROR  *  WR17  -  21203  . (WR17)",/, 

0222  *•  NUMBER  OF  STEPS  MUST  BE  FROM  1  TO  520/ (FREQUENCY  STEPS )~1.", 

0223  *  /,"  REENTER  THE  NUMBER  OF  AZIMUTH  STEPS.") 

0224  GO  TO  1000 

0225  1190  WRITE(CRT,1200) 

0226  1200  FORMAT(/,"  Enter  the  step  size  (nn) .  _") 

0227  READ(CRT,*)  ASTEPS 

0228  IF  (ASTEPS  .EQ.  9999)  GO  TO  9090 

0229  WRITE  (CRT, 1209)  II ,IAEND, ASTEPS 

0230  1209  FORMAT  (lA2,"a  52c  6Y",I3,"  x",F6.2) 

0231  GO  TO  610 

0232  C - 

0233  C  Inquire  fron  user;  elevation  step  size  and  nunber  of  steps. 

0234  C - 

0235  2000  WRITE  (CRT, 2009) 

0236  2009  FORMAT  (/,iX, "Enter  the  nunber  of  elevation  steps.  ") 

0237  READ  (CRT,*)  lEEND 

0238  IF  (lEEND  .EQ.  9V99)  GO  TO  9090 
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IF  (lEEND  .CT.  0)  GO  TO  2028 
WRITE  (CRT, 2019) 

2019  FORMAT  </, IX, "ERROR  ♦  UR17  -  21404  . <WR17)',/, 

«  IX, "THE  NUMBER  OF  STEPS  MUST  BE  GREATER  THAN  0.“,/, 

«  IX,  "REENTER  ^HE  NUMBER  OF  ELEVATION  STEPS.") 

GO  TO  2000 

2028  WRITE  (CRT, 2029) 

2029  FORMAT  (/, IX, "Enter  the  elevation  step  size  («n) .  _") 

READ  (CRT,*)  ESTEPS 
IF  (ESTEPS  .Eq.9999)  GO  TO  9090 
WRITE  (CRT, 2039)  11,  lEEND,  ESTEPS 
2039  FORMAT  (lA2,*a  52c  7Y",I3,"  *",F6.2) 

GO  TO  610 

C - 

C  Inquire  froM  the  user:  nicrowave  frequency. 

C - 

C3000  WRITE(CRT,3500) 

C3500  FORMAT(/,"  Enter  the  RF  frequency  (MHi)...  ") 

C  READ(CRT,«)  RFREQ 

C  IF  (RFREQ  .EQ.  9999)  CO  TO  9090 

C  IF  ((RFREQ  .GE.  TEMPI)  .AND.  (RFREQ  .LE.  TEMP2))  CO  TO  3600 
C  WRITE  (CRT, 3509)  TEMPI,  TEMP2 

C3509  FORMAT  (/,iX, "ERROR  ♦  UR17  -  21204  . (WR17) " ,/, IX, 

C  *  "CALIBRATION  ONLY  FROM  ",F6.0,“NHz  TO  " ,F6 . 0 , "MHz . " , 

C  «  /, IX, "FREQUENCY  MUST  BE  BETWEEN  CALIBRATION  LIMITS.", 

C  *  /,lX,"Do  you  wish  to  recalibrate?  (YES/NO)  _") 

C  READ  (CRT, 3599)  IANS 

C3599  FORMAT  (A2) 

C  IF  (IANS  .EQ.  2HYE)  GO  TO  9000 

C  GO  TO  3000 

C3600  WRITE  (CRT,  3609)  II,  RFREQ 
C3609  FORMAT  (lA2,"a  S4c  8Y",F5.0> 

C  GO  TO  610 


C  Inq 

C - 

3000 

3009 


uire  fron  user  subtraction  file  nane 


WRITE  (CRT,  3009) 

FORMAT  (/, IX, "Enter  subtraction  file  none...  _") 

READ  (CRT,  3019)  INSUB 
FORMAT  (3A2) 

TF  ((INSUB(l)  .EQ.  2H99)  .AND.  (INSUB(2)  .EQ.  2H99))  GO  TO  9090 
IF  (INSUB(l)  .EQ.  IHO)  CO  TO  610 
CALL  OPEN  (IDCB,  lERR,  INSUB) 

IF  (lERR  .NE.  -6)  CO  TO  3300 
WRITE  (CRT,  3029) 

FORMAT  (/, IX, "ERROR  •  WR17  -  21005  . (WR17) " , /, IX , 

1  "UNABLE  TO  FIND  THIS  FILE,  TRY  AGAIN") 

GO  TO  3000 

IF  (lERR  .GE.  0)  CO  TO  3400 
WRITE  (CRT,  3309)  lERR 

FORMAT  (/, IX, "ERROR  #*,13,"  OCCURRED  IN  SUBROUTINE  OPEN") 

GO  TO  620 

CALL  READFdDCB,  lERR,  IFAT,  6) 

IF  (lERR  .EQ.  0)  GO  TO  3500 
WRITE  (CRT,  3409)  lERR 

FORMAT  (/,‘  ERROR  *",13,"  OCCURRED  IN  SUBROUTINE  OPEN") 

CO  TO  620 
DO  3800  I  «  1,  15 

CALL  READFdDCB,  lERR ,  IFAT,  6,  LEN) 

IF  (lERR  .EQ.  0)  GO  TO  3600 
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IF  (lERR  .EQ.  ~12)  GO  TO  3550 
WRITE  (CRT, 3509)  lERR 

3509  FORMAT  (/, IX, "ERROR  «*,I3,*  OCCURRED  IN  SUBROUTINE  READF") 

CO  TO  620 
3550  SAT(1,I)  -  0. 

SAT(2,I>  -  0. 

GO  TO  3850 

3600  RADIAN  •  3.141593  «  DAT(3,1)  /  180. 

AHPLIT  -  10.««<-DAT(2,i>  /  20.) 

SAT (1,1)  •  AHPLIT  «  COS  (RADIAN) 

SAT(2,I)  «  AHPLIT  «  SIN  (RADIAN) 

3800  CONTINUE 

3850  WRITE  (CRT,  3859)  II,  INSUB 
3859  FORMAT  (lA2,'o  54c  8Y*,3A2) 

GO  TO  610 

C  Inquire  new  azifiuth  positien  and  call  UR6  te  set  it. 

- - 

4000  WRITE  (CRT, 4090) 

4090  FORMAT  (/, IX, "Enter  new  azinuth  (nn) .  _■) 

READ  (CRT,*)  PRESAZ 

IF  (PRESAZ  .EQ.  9999)  CO  TO  9090 

CALL  SETPO  (CRT, LUAZ, PRESAZ, 2, lERR) 

IF  (lERR  .EQ.  0)  CO  TO  4400 

CALL  WR12  (CRT, lERR,. TRUE., 0,0,IPRNH,IPRNL) 

GO  TO  620 

4400  WRITE  (CRT, 4409)  II, PRESAZ 
4409  FORMAT  (lA2,"a  S2c  9y,F8.3) 

CO  TO  610 

C - 

C  Inquire  new  elevation  and  call  WR6  To  set  it. 

C - 

5000  WRITE  (CRT, 5090) 

5090  FORMAT  (/, IX, “Enter  new  elevation  _") 

READ  (CRT,*)  PRCSEL 

IF  (PRESEL  .EQ.  9999)  GO  TO  9090 

CALL  SETPO  (CRT,  LUEL,  PRESEL,  4,  lERR) 

IF  (lERR  .EQ.  0)  GO  TO  5500 

CALL  WR12  (CRT, lERR, .TRUE. ,0,0, IPRNM,IPRNL) 

GO  TO  620 

5500  WRITE  (CRT, 5509)  II,  PRESEL 
5509  FORMAT  (lA2,"a  52c  10Y-,F8.3) 

GO  TO  610 

C - 

C  Inquire  from  the  useri  nunber  of  readings  per  data  point. 

C - 

6000  WRITE  (CRT, 6009) 

6009  FORMAT  (/,1X, 

*  "Enter  nunber  of  readings  to  average  per  dota  point. 
READ  (CRT,*)  IRNUM 

IF  (IRNUM  .EQ.  9999)  GO  TO  9090 

IF  ((IRNUM  .LE.  32767)  .AND.  (IRNUM  .CT.  0))  GO  TO  6601 
WRITE  (CRT, 6509) 

6509  FORMAT  (/, IX, "ERROR  0  UR17  -  21006  . (WR17)",/, 

*  IX, "NUMBER  TO  AVERAGE  MUST  BE  FROM  1  -  32767.“,/, 

*  IX, "REENTER  NUMBER  OF  READINGS  TO  AVERAGE  PER  POINT.") 
GO  TO  6000 

6600  WRITE  (CRT,  6609)  II,  IRNUM 
6609  FORMAT  <lA2,"a  S2c  11Y",I5) 

GO  TO  610 
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C  Inquire  fron  user t  nunber  of  scans  per  graph. 


7000  URITE  (CRT, 7009) 

7009  FORMAT  (/,1X, 'Enter  nunber  of  scans  between  graphs  on  screen. 
READ  (CRT,*)  IPEND 
IF  (IPEND  .EQ.  9999)  CO  TO  9090 
IF  (IPEND  .CE.  0)  GO  TO  7500 
WRITE  (CRT, 7209) 

7209  FORMAT  (/, IX, ‘ERROR  •  WR17  -  21007  . (WR17)‘,/, 

*  IX, ‘NUMBER  OF  SCANS  CAN  NOT  BE  LESS  THAN  0‘,/, 

«  IX, ‘REENTER  NUMBER  OF  SCANS  BETWEEN  GRAPHS  ON  CRT.”) 

GO  TO  7000 

7500  WRITE  (CRT, 7509) 

7509  FORMAT  (/, IX, “Enter  »1»  to  plot  on  CRT  or  »0'  to  plot  on  *, 


*  “plotter.  _") 

READ  (CRT,*)  IGRLOC 
IPFLAC  -  1 
PLUNIT(l)  -  4H-PL0 
PLUNIT(2)  ■  4HTTER 
IF  (IGRLOC  .NE.  1)  GO  TO  7550 


PLUNIT(l)  -  4H  -  C 
PLUNIT(2)  -  4HRT 

7550  IF  (IPEND  .NE.  0)  GO  TO  7600 
IPFLAG  •  0 
PLUNIT(l)  -  4HGRAP 
PLUNIT(2)  ■  4HHS 
7600  ISEND  >  1 

WRITE  (CRT,  7609)  II,  IPEND,  (PLUNITd ) , I-l ,2) 


4HGRAP 

4HHS 


7609  FORMAT  (lA2,‘a  52c  12Y" , 15, 1X,2A4> 
GO  TO  610 


C  Set  antennae  to  first  position  and  crests  disc  data  fils. 

C - 

C  Find  title  for  file. 

8000  WRITE  (CRT, 8009)  ( ITITL( I ) , I«1 , 40 ) 

8009  FORMAT  (/,1X, 

**Enter  title  of  file  or  press  'RETURN'  key  for  following  t 
*/,40A2,/) 

C  Blank  out  rest  of  80  bytes  of  title. 

REG  -  EXEC  (l,401B,ITITL,-80) 

IF  (IREG(2)  .EQ.  0)  CO  TO  8100 
IF  (IREG(2)  .GT.  78)  CO  TO  8060 
DO  8050  I  -  (IREG(2)t-3)/2,40 
8050  ITITL(I)  ■  2H 

8060  IF  (  (IREG(2)/2)«2  .EQ.  IREC(2))  CO  TO  8100 

ITITL(IREG(2)/2+l)  »  ( ITITL( lREC(2)/2+l )/256)*256  ♦  32 
C  Set  azinuth  to  -(1/2  of  scan). 

8100  P08ITN  >  PRESAZ-ASTEPS*(IAEND-l)/2 
PARAM  ■  POSITN 
CALL  WR6(PARAM,IERR,2,0) 

IF  (lERR  .EQ.O)  CO  TO  8200 

CALL  WR12(CRT,IERR, .TRUE. , 0 , 0 , IPRNM, IPRNL) 

CO  TO  620 

C  Record  size  ■  3  double  words  *  (steps  in  scan  *  1). 

8200  IS1ZE(2)  -  6  *  (lAEND  *  1) 

C  Mininun  record  size  *  128. 

IF  (IS1ZE(2)  .LT.  128)  ISIZE(2)  ■  128 
C  File  size  =  record  size  *  (elevotion  steps  *  frequency  steps 
ISIZE(l)  »  (ISIZE(2)  *  (lEEND  *  IFEHD  +  1)  ♦  127)/128 


key  for  following  title.”. 
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8300  NAMEF(3)  -  NAHEF(3)  ♦  1 

CALL  GREAT  ( IDCB,IERR,NAHEF, ISIZE,2) 

IF  (lERR  .CE.  0)  GO  TO  8450 
IF  (lERR  .EQ.  -2)  CO  TO  8300 
WRITE  (CRT, 8409)  lERR 

8409  FORHAT  (/, IX. "ERROR  •".IS,-  OCCUREO  IN  SUBROUTINE  GREAT* > 

CO  TO  9090 

8450  IF  (PRNT  .EQ.  0)  CO  TO  850B 
C  Print  title  and  nenv  on  lin*  printor. 

WRITE  (PRNT, 8459)  ( ITITL(I) , I-l ,40) , <NAHEF( I ) ,1-1 ,3) 

8459  FORMAT  ( "1 " ,40A2,/,1X, "FILE  -  •,3A2) 

WRITE  (PRNT, 600)  I AEND, A8TEP8, lEEND, ESTEPS, XNSUB.PRESAZ, 

*  PRE8EL,IRNUN,IPEND,PLUNXT,PRNTL 

8500  WRITE  (CRT, 8509)  NANEF 

8519  FORMAT  (/,iX,"NANE  OF  DATA  FILE  IS  •,3A2> 

C  Pot  spociPications  in  first  record. 

CALL  FTIME(IFAT) 

DO  8550  1-1,40 
8550  IFAT(15+I)  -  ITITL(I) 

IFAT(56)  -  2HEL 
IFAT(57)  -  0 
IFAT(58)  -  I AEND 
FAT (30)  »  ASTEPS 
IFAT(61)  «  0 
IFAT(62)  -  lEEND 
FAT (32)  «  ESTEPS 
FAT (33)  -  RFREQ 
IFAT(67)  -  ISIZE(l) 

IFAT(6a)  -  ISIZE(2) 

IFAT(69)  -  0 
IFAT(70)  -  IFEND 
FAT(36)  -  FSTEPS 
ILFLAG  -  1 

CALL  WRITF  (IDCB,  lERR,  FAT) 

IF  (lERR  .EQ.  0)  CO  TO  8700 
WRITE  (CRT, 8609)  lERR 

FORMAT  (/, IX, "ERROR  •  *,13,"  OCCURED  IN  SUBROUTINE  WRITF") 
GO  TO  9090 


8609 


C  Elevation  scan  fron  PRESEL  to  PRE8EL4E8TEPS«(IEEND-1)  or  until  9raph 

8700  IF  (IPEND  .EQ.  0)  I8END  -  lEEND 
ID  -  1 

IDRCT  -  1 

8701  DO  8900  J-l,lSENO 

IF  (J  ♦  IDONE  .EQ.  1)  GO  TO  8720 

C  If  not  first  scan,  switch  direction  and  increnent  elevation. 

IDRCT  -  -IDRCT 

PRESEL  -  PRESEL  ♦  ESTEPS 

PARAM  -  PRESEL 

CALL  WR6  (PARAM,  lERR,  4,  1) 

IF  (lERR  .EQ.  0)  GO  TO  8720 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  620 

8720  CALL  WRt  (CRT,  LUEL,  TRUEL,  lERR,  0) 

IF  (lERR  .EQ.  0)  CO  TO  8725 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  IPRNM,  IPRNL) 

GO  TO  9090 

- - 

C  Azinuth  scan  fron  PRESAZ-ASTEPS*( lAEND-l )/2  to  PRESAZ+ASTEPS*( lAEND-l )/2 
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8725  DO  8800  I-1,IAEND 
C  If  break  flag  set,  go  bock  to  Menu. 

IF  (IFBRK(IERR))  523,8730 
8730  CALL  WRl  (CRT,  LUAZ,  TRUAZ,  XERR,  0) 

IF  (lERR  .EQ.  0)  GO  TO  8735 

CALL  WR12  (CRT,  lERR,  .TRUE.,  0,0,  XPRNH,  XPRNL) 

CO  TO  9090 

C  Do  frequency  scon  at  eoch  poeitlon. 

8735  CALL  C0R85(1,  4,  IRNUH) 

DO  8790  L  •  1,  IFEND 
CALL  CALF2(2,  L,  F) 

CALL  CP0L2(CH(1,L),X,Y) 

IF  (INSUB(l)  .EQ.  IHO)  CO  TO  8750 
RADIAN  -  3.141593  «  Y  /  180. 

Y  -  X  «  SIN  (RADIAN)  -  SAT  (2,L> 

X  >  X  «  COS  (RADIAN)  -  SAT  (i,L) 

XX  «  X*X  +  V*Y 

Y  -  180.  *  ATAN2(Y,  X>  /  3.141593 
GO  rO  8755 

8750  XX  «  X  *  X 

8755  RLOSS  -  -10  «  ALOGT  (XX) 

IF  (ILFLAG  .EQ.O)  CO  TO  8780 
WRITE  (CRT, 8779)  F, TRUAZ, RLOSS, Y 

8779  FORMAT  (lX,“FHEa  ,F6 . 0 ,5X, -AZIHUTH  -■,FB.3,SX, 

«  “RLOSS  -■,F9.4,SX,“PHASE  ■•,FB.3) 

8780  IL  -  ID  <L  -  1)  «  (lAEND  *  1) 

DAT  (1,  ID  a  TRUAZ 

DAT (2,  ID  -  RLOSS 
DAT(3,IL)  ■  Y 
8790  CONTINUE 

IF  (I  .Ce.  lAEND)  GO  TO  8800 
ID  «  ID  4  IDRCT 

POSITN  ■  POSITN  +  IDRCT  •  ASTEP8 

PARAM  -  POSITN 

CALL  WR6(PARAM,IERR,2,0) 

IF  (lERR  .EQ.O)  GO  TO  8800 

CALL  UR12(CRT,IERR, .TRUE. ,0,0, IPRNH,IPRNL) 

GO  TO  9090 
8800  CONTINUE 

C - 

C  End  of  aziMiuth  scan  loop. 

C - 

IF  (PRNT  .EQ.  0)  GO  TO  8830 
WRITE  (PRNT, 8829)  TRUEL 

8829  FORMAT  (//,5X, “ELEVATION  -“,FB.3) 

8830  DO  8890  L  -  1,  IFEND 

ILB  -  1  (L  -1)  «  (lAEND  *  1) 

ILE  -  L  «  (lAENO  *  i> 

DAT(1,ILE)  -  TRUEL 

DAT(2,ILE)  -  RFREQ  ♦  (L  -  1)  «  FSTEP8 
IF  (PRNT  .EQ.  0)  CO  TO  8850 
DO  8840  IE  -  ILB,ILE  -  1 

8840  WRITE  (PRNT,  8849)  DAT(2,ILE),  (DAT( I ,IE > ,1*1 ,3) 

8849  FORMAT  (IX, “FREQ  •“,F6. 0,5X, “AZIN  -“,F8.3, 

»  5X, “RLOSS  -“,F8.3,SX,“PHASE  -“,F8.3) 

8850  CALL  WRITF  ( IDCB , lERR ,DAT( 1 , ILB) ) 

IF  (lERR  .EQ.  0)  CO  TO  8890 

WRITE  (CRT, 8859)  lERR 

8859  FURHAT  (/, IX, “ERROR  ♦  “,I3,“  OCCURED  IN  SUBROUTINE  WRITF“) 
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GO  TO  9090 
8890  CONTINUE 
8900  CONTINUE 


End  of  elevation  scan  loop 


IDONE  »  IDONE  ISEND 

If  no  scans,  go  to  reset  origianl  position. 
IF  (IPFLAC  .LT.  1)  GO  TO  515 


C  Call  EXEC  to  overlay  this  segnent  with  WR15C 

C - 

8990  IF  (IGRLOC  .EQ.  1)  GO  TO  8995 
INA15(3)  -  2HG 
GO  TO  8998 
8995  INA15(3)  *  2HT 
8998  CALL  EXEC  ( ICOOE, INAi5) 

C9000  WRITE  <CRT,9009) 

C9009  FORMAT  <2/, IX, "Run  progran  AGS02  for  new  calibration.") 
9090  WRITE  (CRT, 9099) 

9099  FORMAT  (/,10X, 

*"»«««««««««  program  WR17  TERMINATED  ***»»***»*•) 

CALL  CLOSE  (IDCB) 


C  Subroutine  SETPO  calls  WR6  to  set  an  azinuth  or  elevation  position 
C  and  then  calls  WRl  to  check  the  position.  If  it  is  within  .002  it 
C  returns,  if  not  it  calls  WR6  once  again. 


SUBROUTINE  SETPO<CRT,LU,PR£S,UNIT, lERR ) 
DO  100  I  a  1,2 
PARAM  *  PRES 

CALL  UK6  (PARAM, lERR, UNIT, 0) 

IF  (lERR  .NE.  0)  RETURN 
IF  (I  .GT.  1)  RETURN 
IF  (LU  ,EQ,  33)  GO  TO  90 
CALL  WKl  (CRT,LU,NEW,IERR,0) 

GO  TO  91 

90  CALL  WK3  (CRT,LU ,NEW, lERR , 0 ) 

91  IF  (lERR  .NE.  0)  RETURN 

IF  (ABS(NEW-PRES)  .LT.  .002)  RETURN 
100  CONTINUE 
RETURN 
END 
END4 
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